Code
- {$A+,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
- {$MINSTACKSIZE $00004000}
- {$MAXSTACKSIZE $00100000}
- {$IMAGEBASE $00400000}
- {$APPTYPE GUI}
- program FileSplitter;
- uses
- windows,
- messages,
- CommDlg,
- ShlObj,
- CommCtrl,
- ShellAPI,
- MpuTools in 'units\MpuTools.pas',
- globals in 'units\globals.pas';
- {$R 'res\Resource.res'}
- {$R 'res\XPTheme.res'}
- type
- TSplitThreadParams = record
- FileToSplit: array[0..MAX_PATH] of Char;
- DestFolder: array[0..MAX_PATH] of Char;
- SizeOfParts: Int64;
- CntParts: Int64;
- end;
- PSplitThreadParams = ^TSplitThreadParams;
- var
- TickStart : DWORD;
- function GetVersionInfo(var VersionString, Description: string): DWORD;
- type
- PDWORDArr = ^DWORDArr;
- DWORDArr = array[0..0] of DWORD;
- var
- VerInfoSize : DWORD;
- VerInfo : Pointer;
- VerValueSize : DWORD;
- VerValue : PVSFixedFileInfo;
- LangInfo : PDWORDArr;
- LangID : DWORD;
- Desc : PChar;
- i : Integer;
- begin
- result := 0;
- VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), LangID);
- if VerInfoSize <> 0 then
- begin
- VerInfo := Pointer(GlobalAlloc(GPTR, VerInfoSize));
- if Assigned(VerInfo) then
- try
- if GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo) then
- begin
- if VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize) then
- begin
- with VerValue^ do
- begin
- VersionString := Format('%d.%d.%d.%d', [dwFileVersionMS shr 16, dwFileVersionMS and $FFFF,
- dwFileVersionLS shr 16, dwFileVersionLS and $FFFF]);
- end;
- end
- else
- VersionString := '';
- // Description
- if VerQueryValue(VerInfo, '\VarFileInfo\Translation', Pointer(LangInfo), VerValueSize) then
- begin
- if (VerValueSize > 0) then
- begin
- // Divide by element size since this is an array
- VerValueSize := VerValueSize div sizeof(DWORD);
- // Number of language identifiers in the table
- (********************************************************************)
- for i := 0 to VerValueSize - 1 do
- begin
- // Swap words of this DWORD
- LangID := (LoWord(LangInfo[i]) shl 16) or HiWord(LangInfo[i]);
- // Query value ...
- if VerQueryValue(VerInfo, @Format('\StringFileInfo\%8.8x\FileDescription', [LangID])[1], Pointer(Desc),
- VerValueSize) then
- Description := Desc;
- end;
- (********************************************************************)
- end;
- end
- else
- Description := '';
- end;
- finally
- GlobalFree(THandle(VerInfo));
- end
- else // GlobalAlloc
- result := GetLastError;
- end
- else // GetFileVersionInfoSize
- result := GetLastError;
- end;
- function GetCheck(hDlg: THandle; ID: DWORD): Boolean;
- begin
- Result := IsDlgButtonChecked(hDlg, ID) = BST_CHECKED;
- end;
- function SetCheck(bCheck: Boolean): DWORD;
- begin
- if bCheck then
- Result := BST_CHECKED
- else
- Result := BST_UNCHECKED;
- end;
- function InsertBlanks(s: string): string;
- var
- i : Integer;
- begin
- for i := length(s) downto 1 do
- begin
- if i mod 3 = 0 then
- begin
- Insert(' ', s, i - 1);
- end;
- end;
- Result := s;
- end;
- function BuildBatchFile(BatchFilename: string): Integer;
- var
- s : string;
- Loop : Integer;
- F : TextFile;
- len : Integer;
- begin
- s := 'copy /b ';
- len := length(Files);
- for Loop := 0 to len - 1 do
- begin
- s := s + '"' + Files[Loop] + '"' + ' + ';
- end;
- s := copy(s, 0, length(s) - 2);
- s := s + ' ' + '"' + ChangeFileExt(Files[0], '') + '"';
- AssignFile(F, BatchFilename);
- {$I-}
- Rewrite(F);
- {$I+}
- if IOResult = 0 then
- begin
- Writeln(F, s);
- CloseFile(F);
- end;
- result := GetLastError();
- end;
- function SplitFile(Filename, DestFolder: string; SplitSize, CntParts: Int64): Integer;
- function GetClusterSize(Drive: Char): Cardinal;
- var
- SectorPerCluster: Cardinal;
- BytesPerSector : Cardinal;
- NumberOfFreeClusters: Cardinal;
- TotalNumberOfClusters: Cardinal;
- begin
- GetDiskFreeSpace(PChar(Drive + ':\'), SectorPerCluster, BytesPerSector, NumberOfFreeClusters,
- TotalNumberOfClusters);
- Result := SectorPerCluster * BytesPerSector;
- end;
- var
- hFile : THandle;
- SizeOfFile : Int64;
- hPart : THandle;
- Loop : Cardinal;
- Partname : string;
- BlockSize : Cardinal;
- MemBuffer : array of Byte;
- minlen : Integer;
- BytesToRead, BytesRead, BytesWritten: Integer;
- OverallBytesRead : Int64;
- ProgressCurrent, ProgressOld: Int64;
- begin
- TickStart := GetTickCount;
- BlockSize := -(-GetClusterSize(FileName[1]) and -GetClusterSize(DestFolder[1]) and -1048576);
- SetLength(MemBuffer, BlockSize - 1);
- bRunning := 1;
- OverallBytesRead := 0;
- SizeOfFile := GetFileSize(PChar(Filename));
- hFile := CreateFile(PChar(Filename), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL
- or FILE_FLAG_SEQUENTIAL_SCAN or FILE_FLAG_WRITE_THROUGH, 0);
- if hFile <> INVALID_HANDLE_VALUE then
- begin
- for Loop := 1 to CntParts do
- begin
- // Reset variables
- ProgressOld := 0;
- BytesToRead := SplitSize;
- // build filename of the parts
- Partname := DestFolder + '\' + ExtractFilename(Filename) + Format('.%3.3d', [Loop]);
- if FileExists(Partname) then
- DeleteFile(PChar(Partname));
- hPart := CreateFile(PChar(Partname), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL
- or FILE_FLAG_SEQUENTIAL_SCAN or FILE_FLAG_WRITE_THROUGH, 0);
- if hPart <> INVALID_HANDLE_VALUE then
- begin
- repeat
- minlen := Min(length(MemBuffer), BytesToRead);
- BytesRead := FileRead(hFile, MemBuffer[0], minLen);
- if BytesRead > -1 then
- begin
- BytesWritten := FileWrite(hPart, MemBuffer[0], BytesRead);
- Dec(BytesToRead, length(MemBuffer));
- // progress stuff ////////////////////////////////////////////////////
- OverallBytesRead := OverallBytesRead + BytesWritten;
- ProgressCurrent := (OverallBytesRead * 100) div SizeOfFile;
- if ProgressCurrent <> ProgressOld then
- begin
- ProgressOld := ProgressCurrent;
- end;
- SendMessage(hApp, FSM_PROGRESS, ProgressCurrent, Integer(PChar(Partname)));
- end
- else
- begin
- MessageBox(hApp, PChar(SysErrorMessage(GetLastError)), PChar(APPNAME), 0);
- Break;
- end;
- //////////////////////////////////////////////////////////////////////
- until (BytesToRead <= 0) or (bRunning = 0);
- end;
- FileClose(hPart);
- if bRunning = 0 then
- Break;
- end;
- FileClose(hFile);
- end;
- SendMessage(hApp, FSM_FINISH, GetTickCount - TickStart, GetLastError());
- result := GetLastError();
- end;
- function SplitThread(Param: Pointer): Integer;
- var
- Filename : string;
- DestFolder : string;
- SplitSize : Int64;
- CntParts : Int64;
- ECode : Integer;
- begin
- result := 0;
- Filename := PSplitThreadParams(Param)^.FileToSplit;
- DestFolder := PSplitThreadParams(Param)^.DestFolder;
- SplitSize := PSplitThreadParams(Param)^.SizeOfParts;
- CntParts := PSplitThreadParams(Param)^.CntParts;
- ECode := SplitFile(Filename, DestFolder, SplitSize, CntParts);
- if bRunning = 1 then
- begin
- if (ECode = 0) or (ECode = 183) then
- begin
- BuildBatchFile(DestFolder + '\' + ChangeFileExt(ExtractFilename(Filename), '.bat'));
- end
- else
- Messagebox(0, @SysErrorMessage(ECode)[1], APPNAME, MB_ICONSTOP);
- end;
- Dispose(Param);
- end;
- function CalcCntParts(const Filename: string; Size: Int64): Cardinal;
- var
- FileSize : Int64; // >4GB
- begin
- result := 0;
- if Size > 0 then
- begin
- FileSize := GetFileSize(PChar(Filename));
- if (FileSize > 0) and (FileSize div Size < High(Integer)) then
- result := (FileSize - 1) div Integer(Size) + 1;
- end;
- end;
- function CalcFileSize(const Filename: string; CntParts: Cardinal): Int64;
- var
- SizeF : Extended;
- Size : Int64;
- FileSize : Int64;
- begin
- //Size := 0;
- SizeF := 0.0;
- FileSize := GetFileSize(PChar(Filename));
- if (FileSize > 0) and (CntParts <> 0) then
- begin
- SizeF := FileSize / CntParts;
- end;
- Size := Round(SizeF);
- result := Size + 1;
- end;
- procedure EnableControls(hDlg: HWND; Enabled: Boolean);
- begin
- EnableWindow(GetDlgItem(hDlg, IDC_BTNSPLIT), Enabled);
- EnableWindow(GetDlgItem(hDlg, IDC_BTNCANCEL), Enabled);
- EnableWindow(GetDlgItem(hDlg, IDC_EDTFILETOSPLIT), Enabled);
- EnableWindow(GetDlgItem(hDlg, IDC_BTNOPENSPLITFILE), Enabled);
- EnableWindow(GetDlgItem(hDlg, IDC_EDTTARGETFOLDER), Enabled);
- EnableWindow(GetDlgItem(hDlg, IDC_BTNSELFOLDER), Enabled);
- EnableWindow(GetDlgItem(hDlg, IDC_CHKCOPYTODISK), Enabled);
- EnableWindow(GetDlgItem(hDlg, IDC_EDTFILESIZE), Enabled);
- end;
- function dlgfunc(hDlg: hWnd; uMsg: dword; wParam: wParam; lParam: lParam):
- bool; stdcall;
- var
- MyFont : HFONT;
- rect : TRect;
- pt : TPoint;
- dwReturn : DWORD;
- Version : string;
- Description : string;
- SplitThreadParams : PSplitThreadParams;
- buffer : array[0..MAX_PATH] of Char;
- s : string;
- Translated : LongBool;
- hThread : THandle;
- ThreadID : Cardinal;
- Speed : String;
- begin
- result := true;
- case uMsg of
- WM_INITDIALOG:
- begin
- Files := nil;
- hApp := hDlg;
- if SendMessage(hDlg, WM_SETICON, ICON_BIG, Integer(LoadIcon(hInstance, MAKEINTRESOURCE(1)))) = 0 then
- SendMessage(hDlg, WM_SETICON, ICON_SMALL, Integer(LoadIcon(hInstance, MAKEINTRESOURCE(1))));
- MyFont := CreateFont(FontSize, 0, 0, 0, 900, 0, 0, 0, ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
- DEFAULT_QUALITY, DEFAULT_PITCH, FontName);
- if MyFont <> 0 then
- SendDlgItemMessage(hDlg, 999, WM_SETFONT, Integer(MyFont), Integer(true));
- s := APPNAME;
- SetWindowText(hDlg, pointer(s));
- SendDlgItemMessage(hDlg, IDC_UDPARTS, UDM_SETRANGE32, 1, 999);
- EnableControl(hDlg, IDC_OPT_SIZE, FALSE);
- EnableControl(hDlg, IDC_OPT_PARTS, FALSE);
- EnableControl(hDlg, IDC_UDPARTS, FALSE);
- SendDlgItemMessage(hDlg, IDC_EDT_SIZE, EM_SETREADONLY, -1, 0);
- SendDlgItemMessage(hDlg, IDC_EDT_PARTS, EM_SETREADONLY, -1, 0);
- SendDlgItemMessage(hDlg, IDC_EDT_PARTS, EM_SETLIMITTEXT, 3, 0);
- CheckDlgButton(hDlg, IDC_OPT_SIZE, BST_CHECKED);
- end;
- WM_CTLCOLORSTATIC:
- begin
- case GetDlgCtrlId(lParam) of
- 999:
- begin
- whitebrush := CreateBrushIndirect(WhiteLB);
- SetBkColor(wParam, WhiteLB.lbColor);
- result := BOOL(whitebrush);
- end;
- else
- SetBkColor(wParam, GetSysColor(COLOR_BTNFACE));
- SetBkMode(wParam, TRANSPARENT);
- result := BOOL(GetSysColorBrush(COLOR_BTNFACE));
- end;
- end;
- { let's move it, move it }
- WM_LBUTTONDOWN:
- begin
- SetCursor(LoadCursor(0, IDC_SIZEALL));
- SendMessage(hDlg, WM_NCLBUTTONDOWN, HTCAPTION, lParam);
- end;
- WM_SIZE:
- begin
- MoveWindow(GetDlgItem(hDlg, 999), 0, 0, loword(lParam), 75, TRUE);
- s := APPNAME;
- SetDlgItemText(hDlg, 999, pointer(s));
- SetWindowPos(GetDlgItem(hDlg, 124), GetDlgItem(hDlg, 999), loword(lParam) - 47, 7, 40, 22, 0);
- SetWindowPos(GetDlgItem(hDlg, 129), GetDlgItem(hDlg, 999), loword(lParam) - 47, 35, 40, 22, 0);
- GetWindowRect(GetDlgItem(hDlg, 999), rect);
- pt.X := rect.Left;
- pt.Y := rect.Bottom;
- ScreenToClient(hDlg, pt);
- MoveWindow(GetDlgItem(hDlg, 998), 0, pt.Y, rect.Right - rect.Left, 2, True);
- MoveWindow(GetDlgItem(hDlg, 997), 0, 250, rect.Right - rect.Left, 2, True);
- end;
- WM_COMMAND:
- begin
- if wParam = ID_CANCEL then
- SendMessage(hDlg, WM_CLOSE, 0, 0);
- if hiword(wParam) = BN_CLICKED then
- begin
- case loword(wParam) of
- IDC_BTNABOUT:
- begin
- dwReturn := GetVersionInfo(Version, Description);
- if dwReturn = 0 then
- begin
- s := Format(INFO_TEXT, [Version, Description]);
- MyMessageBox(hDlg, APPNAME, s, 1);
- end
- else
- Messagebox(hDlg, PChar(SysErrorMessage(dwReturn)), APPNAME, MB_ICONSTOP);
- end;
- IDC_BTNOPENSPLITFILE:
- begin
- SetDlgItemText(hDlg, IDC_EDT_SIZE, nil);
- SetDlgItemText(hDlg, IDC_EDT_PARTS, nil);
- FileToSplit := OpenFile(hDlg, '');
- if FileToSplit <> '' then
- begin
- SetDlgItemText(hDlg, IDC_EDTFILETOSPLIT, PChar(FileToSplit));
- FileSize := GetFilesize(FileToSplit);
- Str(FileSize / 1024 / 1024: 0: 2, s);
- SetWindowText(GetDlgItem(hDlg, IDC_STCSTATUSWND), PChar(s + ' MB'));
- end;
- end;
- IDC_BTNSELFOLDER:
- begin
- dwReturn := GetFolder(hDlg, 0, rsChooseFolder, TargetDir);
- if dwReturn = 0 then
- SetDlgItemText(hDlg, IDC_EDTTARGETFOLDER, PChar(TargetDir))
- else
- Messagebox(hDlg, PChar(SysErrorMessage(dwReturn)), APPNAME, MB_ICONSTOP);
- end;
- IDC_OPT_SIZE, IDC_OPT_PARTS:
- begin
- SendDlgItemMessage(hDlg, IDC_EDT_SIZE, EM_SETREADONLY, Integer(not GetCheck(hDlg, IDC_OPT_SIZE)), 0);
- SendDlgItemMessage(hDlg, IDC_EDT_PARTS, EM_SETREADONLY, Integer(GetCheck(hDlg, IDC_OPT_SIZE)), 0);
- EnableControl(hDlg, IDC_UDPARTS, not GetCheck(hDlg, IDC_OPT_SIZE));
- if loword(wParam) = IDC_OPT_SIZE then
- SetFocus(GetDlgItem(hDlg, IDC_EDT_SIZE));
- if loword(wParam) = IDC_OPT_PARTS then
- SetFocus(GetDlgItem(hDlg, IDC_EDT_PARTS));
- end;
- IDC_BTNSPLIT:
- begin
- Idx := 0;
- setlength(Files, 0);
- New(SplitThreadParams);
- GetDlgItemText(hDlg, IDC_EDTFILETOSPLIT, buffer, sizeof(buffer));
- lstrcpy(SplitThreadParams.FileToSplit, buffer);
- GetDlgItemText(hDlg, IDC_EDTTARGETFOLDER, buffer, sizeof(buffer));
- lstrcpy(SplitThreadParams.DestFolder, Buffer);
- SplitThreadParams.SizeOfParts := SizeOfParts;
- SplitThreadparams.CntParts := CountParts;
- SetLength(Files, CountParts);
- hThread := BeginThread(nil, 0, SplitThread, SplitThreadParams, 0, ThreadID);
- if hThread <> 0 then
- begin
- CloseHandle(hThread);
- EnableControls(hDlg, False);
- EnableWindow(GetDlgItem(hDlg, IDC_BTNCANCEL), True);
- end;
- end;
- IDC_BTNCANCEL:
- begin
- InterlockedExchange(bRunning, 0);
- end;
- end;
- end;
- if hiword(wParam) = EN_CHANGE then { edit changed }
- begin
- case loword(wParam) of
- IDC_EDTFILETOSPLIT, IDC_EDTTARGETFOLDER:
- begin
- GetDlgItemText(hDlg, IDC_EDTFILETOSPLIT, buffer, MAX_PATH);
- FileToSplit := string(buffer);
- GetDlgItemText(hDlg, IDC_EDTTARGETFOLDER, buffer, MAX_PATH);
- TargetDir := string(buffer);
- EnableControl(hDlg, IDC_OPT_SIZE, (FileExists(FileToSplit)) and (DirectoryExists(TargetDir)));
- SendDlgItemMessage(hDlg, IDC_EDT_SIZE, EM_SETREADONLY, Integer(not (FileExists(FileToSplit) and
- (DirectoryExists(TargetDir)))), 0);
- EnableControl(hDlg, IDC_OPT_PARTS, (FileExists(FileToSplit)) and (DirectoryExists(TargetDir)));
- //if not FileExists(FileToSplit) then
- // SetDlgItemText(hDlg, IDC_STCSTATUSWND, PChar(rsFileNotExists))
- // else
- // SetDlgItemText(hDlg, IDC_STCSTATUSWND, '');
- // if not DirectoryExists(TargetDir) then
- // SetDlgItemText(hDlg, IDC_STCSTATUSWND, PChar(rsFolderNotExists))
- // else
- // SetDlgItemText(hDlg, IDC_STCSTATUSWND, '');
- if ((FileExists(FileToSplit)) and (DirectoryExists(TargetDir)) and (SizeOfParts > 0))
- or ((FileExists(FileToSplit)) and (DirectoryExists(TargetDir)) and (CountParts > 1)) then
- EnableControl(hDlg, IDC_BTNSPLIT, True)
- else
- EnableControl(hDlg, IDC_BTNSPLIT, False);
- end;
- IDC_EDT_SIZE:
- begin
- if GetCheck(hDlg, IDC_OPT_SIZE) then
- begin
- SizeOfParts := GetDlgItemInt(hDlg, IDC_EDT_SIZE, Translated, False) * 1024 * 1024;
- CountParts := CalcCntParts(FileToSplit, SizeOfParts);
- SetDlgItemInt(hDlg, IDC_EDT_PARTS, CountParts, False);
- end;
- if ((FileExists(FileToSplit)) and (DirectoryExists(TargetDir)) and (SizeOfParts > 1))
- or ((FileExists(FileToSplit)) and (DirectoryExists(TargetDir)) and (CountParts > 1)) then
- EnableControl(hDlg, IDC_BTNSPLIT, True)
- else
- EnableControl(hDlg, IDC_BTNSPLIT, False);
- end;
- IDC_EDT_PARTS:
- begin
- if not GetCheck(hDlg, IDC_OPT_SIZE) then
- begin
- CountParts := GetDlgItemInt(hDlg, IDC_EDT_PARTS, Translated, False);
- SizeOfParts := CalcFileSize(FileToSplit, CountParts);
- Str((SizeOfParts / 1024 / 1024):0:3, s);
- SetDlgItemText(hDlg, IDC_EDT_SIZE, PChar(s));
- end;
- if ((FileExists(FileToSplit)) and (DirectoryExists(TargetDir)) and (SizeOfParts > 1))
- or ((FileExists(FileToSplit)) and (DirectoryExists(TargetDir)) and (CountParts > 1)) then
- EnableControl(hDlg, IDC_BTNSPLIT, True)
- else
- EnableControl(hDlg, IDC_BTNSPLIT, False);
- end;
- end;
- end;
- end;
- WM_CLOSE:
- begin
- EndDialog(hDlg, 0);
- end;
- FSM_PROGRESS:
- begin
- s := ExtractFilename(string(PChar(Pointer(lParam))));
- if (s <> PrevFile) and (Idx <= High(Files)) then
- begin
- Files[Idx] := s;
- PrevFile := s;
- Inc(Idx);
- end;
- SetDlgItemText(hDlg, IDC_STCSTATUSWND, PChar(s));
- s := Format('%d%% - %s', [wParam, APPNAME]);
- SetWindowText(hDlg, PChar(s));
- end;
- FSM_FINISH:
- begin
- EnableControls(hDlg, True);
- EnableWindow(GetDlgItem(hDlg, IDC_BTNCANCEL), False);
- SetDlgItemText(hDlg, IDC_STCSTATUSWND, '');
- SetWindowText(hDlg, PChar(APPNAME));
- Str(wParam / 1000:0:2, s);
- //s := Format('Dauer: %d msec', [WParam]);
- Str((FileSize / (wParam / 1000) / 1024 / 1024):0:2, Speed);
- SetDlgItemText(hDlg, IDC_STCSTATUSWND, PChar(s + ' sec [' + Speed + ' MB/sec]'));
- end;
- else
- result := false;
- end;
- end;
- begin
- InitCommonControls;
- DialogBox(hInstance, MAKEINTRESOURCE(100), 0, @dlgfunc);
- end.