Guidance
指路人
g.yi.org
software / rapidq / Examples / File & Directory / QFSplitter / QFSplitter.bas

Register 
注册
Search 搜索
首页 
Home Home
Software
Upload

  
' QFSplitter.bas for rapidq
' coded by Mesut Akcan
' updated 30 june 2000
' http://kaynak.cjb.net
' http://makcan.virtualave.net
' makcan@softhome.net

     $OPTIMIZE ON
     $APPTYPE GUI
     $TYPECHECK ON
     $OPTION ICON "SPLIT.ICO"
     $INCLUDE "RAPIDQ.INC"

     $RESOURCE BACK_BMP AS "BACK1.BMP"
     $RESOURCE OPENBMP AS "OPEN.BMP"
     $RESOURCE SPLITBMP AS "SPLIT.BMP"
     $RESOURCE HELPBMP AS "HELP.BMP"
     $RESOURCE EXITBMP AS "EXIT.BMP"

     DECLARE FUNCTION FPATH(FPFN AS STRING)AS STRING
     DECLARE SUB OKCLICK
     DECLARE SUB CANCELCLICK
     DECLARE SUB SRCSELECTCLICK (SENDER AS QBUTTON)
     DECLARE SUB TRGSELECTCLICK (SENDER AS QBUTTON)
     DECLARE SUB EDIT3CHANGE (SENDER AS QEDIT)
     DECLARE SUB SPLITCLICK (SENDER AS QBUTTON)
     DECLARE SUB ABOUTCLICK (SENDER AS QBUTTON)
     DECLARE SUB EXITCLICK (SENDER AS QBUTTON)
     DECLARE SUB BACKDRAW (SENDER AS QFORM)

     APPLICATION.TITLE = "Qfilesplitter v1.2"

     CREATE FORM AS QFORM
      CAPTION = APPLICATION.TITLE
      WIDTH = 303
      HEIGHT = 255
      BORDERSTYLE = BSSINGLE
      CENTER
      AUTOSCROLL = 0
      ONPAINT = BACKDRAW
      CREATE MAINMENU AS QMAINMENU
       CREATE MNUFILE AS QMENUITEM
        CAPTION="&File"
        CREATE MNUSOSEL AS QMENUITEM
         CAPTION="S&ource"
         ONCLICK = SRCSELECTCLICK
        END CREATE
        CREATE MNUTARSEL AS QMENUITEM
         CAPTION="&Target path"
         ONCLICK = TRGSELECTCLICK
        END CREATE
        CREATE MNUSPL AS QMENUITEM
         CAPTION = "&Split"
         ENABLED = FALSE
         ONCLICK = SPLITCLICK
        END CREATE
        CREATE MNUBRK AS QMENUITEM
         CAPTION="-"
        END CREATE
        CREATE MNUEXIT AS QMENUITEM
         CAPTION="E&xit"
         ONCLICK = EXITCLICK
        END CREATE
       END CREATE
       CREATE MNUHELP AS QMENUITEM
        CAPTION = "&Help"
        CREATE MNUABOUT AS QMENUITEM
         CAPTION ="&About"
         ONCLICK  = ABOUTCLICK
        END CREATE
       END CREATE
      END CREATE
      CREATE LABEL1 AS QLABEL
       CAPTION = "Path / File (SOURCE):"
       LEFT = 7
       TOP = 37
       WIDTH = 112
       TRANSPARENT = 1
      END CREATE
      CREATE LABEL2 AS QLABEL
       CAPTION = "File size "
       LEFT = 7
       TOP = 80
       WIDTH = 112
       TRANSPARENT = 1
      END CREATE
      CREATE LABEL3 AS QLABEL
       CAPTION = "Path (TARGET):  "
       LEFT = 7
       TOP = 109
       WIDTH = 112
       TRANSPARENT = 1
      END CREATE
      CREATE LABEL4 AS QLABEL
       CAPTION = "Split size(Bytes) :"
       LEFT = 7
       TOP = 173
       WIDTH = 84
       TRANSPARENT = 1
      END CREATE
      CREATE LABEL5 AS QLABEL
       LEFT = 147
       TOP = 167
       WIDTH = 107
       HEIGHT = 29
       ALIGNMENT = 1
       TRANSPARENT = 1
      END CREATE
      CREATE LABEL6 AS QLABEL
       LEFT = 91
       TOP = 195
       TRANSPARENT = 1
      END CREATE
      CREATE EDIT1 AS QEDIT
       TEXT = ""
       LEFT = 7
       TOP = 57
       WIDTH = 253
      END CREATE
      CREATE BUTTON1 AS QBUTTON
       CAPTION = ""
       BMPHANDLE = OPENBMP
       LEFT = 260
       HEIGHT = 22
       TOP = 56
       WIDTH = 27
       SHOWHINT = 1
       HINT = "Select source file"
       TABORDER = 1
       ONCLICK = SRCSELECTCLICK
      END CREATE
      CREATE EDIT2 AS QEDIT
       TEXT = ""
       LEFT = 7
       TOP = 129
       WIDTH = 253
       TABORDER = 2
      END CREATE
      CREATE BUTTON2 AS QBUTTON
       CAPTION = ""
       BMPHANDLE = OPENBMP
       LEFT = 260
       TOP = 128
       WIDTH = 27
       HEIGHT = 22
       SHOWHINT = 1
       HINT = "Select target path "
       TABORDER = 3
       ONCLICK = TRGSELECTCLICK
      END CREATE
      CREATE EDIT3 AS QEDIT
       TEXT = "1457152"
       LEFT = 89
       TOP = 169
       WIDTH = 81
       TABORDER = 4
       ONCHANGE = EDIT3CHANGE
      END CREATE
      CREATE PANEL1 AS QPANEL
       LEFT = 0
       TOP = 0
       WIDTH = 295
       HEIGHT = 31
       ALIGN = 1
       TABORDER = 5
       CREATE BUTTON3 AS QBUTTON
        CAPTION = ""
        BMPHANDLE = SPLITBMP
        LEFT = 3
        TOP = 3
        WIDTH = 35
        SHOWHINT = 1
        HINT = "Split file"
        ONCLICK = SPLITCLICK
       END CREATE
       CREATE BUTTON4 AS QBUTTON
        CAPTION = ""
        BMPHANDLE = HELPBMP
        LEFT = 40
        TOP = 3
        WIDTH = 27
        SHOWHINT = 1
        HINT = "About"
        TABORDER = 1
        ONCLICK = ABOUTCLICK
       END CREATE
       CREATE BUTTON5 AS QBUTTON
        CAPTION = ""
        BMPHANDLE = EXITBMP
        LEFT = 69
        TOP = 3
        WIDTH = 27
        SHOWHINT = 1
        HINT = "Exit"
        TABORDER = 2
        ONCLICK = EXITCLICK
       END CREATE
      END CREATE
     END CREATE
'----------- FORM2 --------------------------
     CREATE FORM2 AS QFORM
      CAPTION = "Select a folder"
      WIDTH = 320
      HEIGHT = 330
      BORDERSTYLE = BSSINGLE
      CENTER
      ONPAINT = BACKDRAW
      CREATE BTNOK AS QBUTTON
       CAPTION = "&OK"
       LEFT = 223
       TOP = 270
       ONCLICK = OKCLICK
      END CREATE
      CREATE BTNCANCEL AS QBUTTON
       CAPTION = "&Cancel"
       LEFT = 138
       TOP = 270
       TABORDER = 1
       ONCLICK = CANCELCLICK
      END CREATE
      CREATE DTREE AS QDIRTREE
       TOP = 5
       LEFT = 5
       WIDTH = 300
       HEIGHT = 260
      END CREATE
     END CREATE
'=========================================================================
     DIM FILE AS QFILESTREAM
     DIM FSIZE AS LONG , SPLSIZE AS LONG , SPL AS LONG
     DIM CRLF AS STRING , C34 AS STRING
     DIM BITMAP AS QBITMAP
     BITMAP.BMPHANDLE = BACK_BMP
     CRLF = CHR$(13) + CHR$(10) : C34  = CHR$(34)
     CALL EDIT3CHANGE (EDIT3)
     FORM.DELBORDERICONS (WSMAXIMIZED)
     FORM2.DELBORDERICONS (WSMAXIMIZED)
     FORM.SHOWMODAL

     SUB SRCSELECTCLICK (SENDER AS QBUTTON)  '---------- SOURCE SELECT
      DIM OPENDIALOG AS QOPENDIALOG
      WITH OPENDIALOG
       IF .EXECUTE THEN
        IF FILE.OPEN(.FILENAME , FMOPENREADWRITE) = FALSE THEN
         SHOWMESSAGE "Problem with reading " + .FILENAME : EXIT SUB
        END IF
        EDIT1.TEXT 	= .FILENAME
        FSIZE	= FILE.SIZE
        FILE.CLOSE
        LABEL2.CAPTION = STR$(FSIZE) + " Bytes"
        EDIT2.TEXT = FPATH(EDIT1.TEXT)
       END IF
      END WITH
      CALL EDIT3CHANGE(EDIT3)
     END SUB

     SUB TRGSELECTCLICK (SENDER AS QBUTTON)	'--------- TARGET SELECT
      WITH DTREE
       IF EDIT2.TEXT THEN .INITIALDIR = EDIT2.TEXT ELSE .INITIALDIR = CURDIR$
      END WITH
      FORM2.SHOWMODAL
     END SUB

     SUB EDIT3CHANGE (SENDER AS QEDIT)		'---------- EDIT3 CHANGE
      DIM KB AS DOUBLE , MB AS DOUBLE , RMN AS LONG
      SPLSIZE = VAL(EDIT3.TEXT)
      IF (SPLSIZE >= FSIZE) OR (SPLSIZE<1) THEN
       BUTTON3.ENABLED  = FALSE
       MNUSPL.ENABLED = FALSE
       LABEL6.CAPTION=""
      ELSE
       BUTTON3.ENABLED  = TRUE
       MNUSPL.ENABLED = TRUE
       RMN = FSIZE MOD SPLSIZE
       SPL = INT(FSIZE/SPLSIZE)
       IF RMN > 0 THEN SPL++
       LABEL6.CAPTION = STR$(SPL) + " split files"
      END IF
      KB = (INT(SPLSIZE / 1024 * 100)) / 100
      MB = (INT(SPLSIZE / 1048576 * 100)) / 100
      LABEL5.CAPTION = STR$(KB) + " KB" + CRLF + STR$(MB) + " MB"
     END SUB

     SUB SPLITCLICK (SENDER AS QBUTTON)			'---------- SPLIT CLICK
      DIM FILE2 AS QFILESTREAM
      DIM SFNAME AS STRING , BATSTR AS STRING , BATSFN AS STRING
      DIM TFNAME AS STRING , BF AS STRING
      DIM N AS SHORT
      WITH EDIT1
       SFNAME = .TEXT - FPATH(.TEXT) 'SOURCE FILE NAME
       IF FILE.OPEN(.TEXT , FMOPENREAD) = FALSE THEN 'OPEN SOURCE FILE
        SHOWMESSAGE "Problem with reading " + .TEXT : EXIT SUB
       END IF
      END WITH
      BATSTR = "@ECHO OFF" + CRLF
      FOR N = 0 TO SPL-1
       FILE.POSITION = N * SPLSIZE
       IF N = SPL-1 THEN SPLSIZE = FILE.SIZE - FILE.POSITION
       TFNAME = SFNAME + "." + RIGHT$ (("00" + STR$(N)) , 3) ' TARGET FILENAME
       IF N>0 THEN BATSFN = C34 + SFNAME + C34 + "+"
       BATSTR = BATSTR + "COPY /B " + BATSFN + C34 + TFNAME + C34 + " " + C34 + SFNAME + C34 + CRLF
       IF FILE2.OPEN(EDIT2.TEXT + TFNAME , FMCREATE) = FALSE THEN  'CREATE TARGET FILE
        SHOWMESSAGE "Problem with creating " + EDIT2.TEXT + TFNAME : EXIT SUB
       END IF
       FILE2.COPYFROM(FILE,SPLSIZE)
       FILE2.CLOSE
      NEXT
      FILE.CLOSE
      BF =  EDIT2.TEXT + "MERGE_" + SFNAME + ".BAT" 	 ' BATCH FILE NAME
      IF FILE.OPEN(BF , FMCREATE) = FALSE THEN  ' CREATE BAT FILE
       SHOWMESSAGE "Problem with creating " + BF
       EXIT SUB
      END IF
      BATSTR = BATSTR + "REM THIS FILE WAS CREATED BY QFILESPLITTER" + CRLF + "REM http://kaynak.cjb.net"
      FILE.WRITESTR(BATSTR,LEN(BATSTR))      ' WRITE TO BATCH FILE
      FILE.CLOSE
      SHOWMESSAGE SFNAME + " SPLITTED !" ' OK.
     END SUB

     FUNCTION FPATH(FPFN AS STRING)AS STRING		'---------- FPATH
      DIM POZ AS SHORT , LASTPOZ AS SHORT
      DO
       POZ = INSTR(LASTPOZ + 1 , FPFN,"\" )
       IF POZ=0 THEN EXIT DO
       LASTPOZ = POZ
      LOOP
      FPATH = LEFT$(FPFN,LASTPOZ)
     END FUNCTION

     SUB ABOUTCLICK (SENDER AS QBUTTON)			'---------- ABOUT CLICK
      SHOWMESSAGE application.title + " freeware" + crlf + "programmed by Mesut Akcan" + crlf _
       + "web: http://kaynak.cjb.net" + crlf + "mail: makcan@softhome.net"
     END SUB
     SUB EXITCLICK (SENDER AS QBUTTON): FORM.CLOSE :END SUB '--- EXIT CLICK
     SUB OKCLICK							'---------- OK CLICK
      EDIT2.TEXT= DTREE.DIRECTORY :	FORM2.CLOSE
     END SUB
     SUB CANCELCLICK : FORM2.CLOSE : END SUB		'---------- CANCEL CLICK

     SUB BACKDRAW (SENDER AS QFORM)			'---------- BACK DRAW
      DIM FW AS INTEGER , FH AS INTEGER , X AS INTEGER , Y AS INTEGER
      DIM BW AS INTEGER , BH AS INTEGER
      BW = BITMAP.WIDTH : BH = BITMAP.HEIGHT
      WITH SENDER
       FW = .CLIENTWIDTH : FH = .CLIENTHEIGHT
       FOR X = 0 TO FW STEP BW
        FOR Y = 0 TO FH STEP BH
         .DRAW(X,Y,BITMAP.BMP)
        NEXT
       NEXT
      END SUB
掌柜推荐
 
 
 
 
 
 
 
 
 
 
 
 
© Mon 2023-2-6  Guidance Laboratory Inc.
Email:webmaster1g.yi.org Hits:0 Last modified:2000-06-30 12:40:26