{* [splitcp.pas] * -------------------------------------------------------------------------- * Returncodes: * 0 Alles OK, Dateien erstellt * 1-7 Fehler * 7 Hilfe wurde ausgegeben *--------------------------------------------------------------------------- * SplitCp is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * SplitCp is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA *--------------------------------------------------------------------------- * 24.02.98 kw 1.00 init * 25.02.98 kw 1.01 batch nun ohne $ im Namen; * I/O-Fehlerbehandlung * Dynamischer Puffer * 24.10.99 kw 1.2 * Untersttzung fr verschiedene Compiler * * Zusammenfgescripts fr DOS, OS/2 und Unix * 01.11.99 kw 1.3 * Bugfix - ein Integer durch Word ersetzen * 26.05.02 kw 1.4 * New parameter -p * * No splitting, if only 1 part * * Help is only showed, if no para are given * * More error messages * 23.12.04 va 1.5 * Kleine Anpassungen fuer Compiler * Virtual Pascal (http://www.vpascal.com) * Somit jetzt Unterstuetzung langer Dateinamen * kw * Versionsnummer nachgetragen :) * * Die Extension wird jetzt mit in den Namen reingetan * (foo.bar.001 statt foo.001). Ebenso bei den * Batches (foo.bar.cmd statt foo.cmd). * * Die Quellen sind also nicht mehr fr DOS brauchbar. * Wowereit! *} {$A+,B-,E+,F-,G-,I-,L+,N-,O-,P-,Q-,R+,S+,T-,V+,X-,Y+} {$IFDEF msdos} {$M 8000,2048,65360} {$ENDIF} PROGRAM SplitCp; USES DOS; FUNCTION asLowerCase(s:STRING):STRING; var sRes : STRING; i : Integer; BEGIN sRes := s; For i := 1 to length(s) do CASE s[i] OF 'Ž' : sRes[i] := '„'; '™' : sRes[i] := '”'; 'š' : sRes[i] := ''; ELSE IF s[i] IN ['A'..'Z'] THEN sRes[i] := Char( Byte(s[i]) + 32) ELSE sRes[i] := s[i]; END; asLowerCase := sRes; END; {--------------------------------------------------------------------------} VAR nPart : WORD; maxsize : LongInt; sDir: DirStr; sBasename: NameStr; sExt : ExtStr; PROCEDURE CalcMaxSize(fromsize:longint); VAR code : LongInt; p2 : STRING; BEGIN maxsize := 1450000; nPart := 1; Code := 0; IF paramcount > 1 THEN BEGIN p2 := ParamStr(2); if (asLowerCase(copy(p2,1,2)) = '-p') THEN BEGIN Val(copy(p2,3,12), nPart, Code); IF (Code = 0) AND (nPart > 0) THEN BEGIN maxSize := (fromsize DIV nPart); {Wenn ein Rest brig bleibt ...} IF (fromsize MOD nPart) > 0 THEN {erh”hen wir die Size um eins, sonst fehlen nachher ein paar Byte} Inc(MaxSize); END; END ELSE BEGIN Val(p2, maxsize, Code); END; END; IF (Code = 0) AND (maxsize > 0) THEN nPart := fromSize div maxsize + 1; {* Error during cnversion to integer? *} IF code <> 0 THEN BEGIN Writeln('Error parsing ',paramstr(2),' at positon: ', Code); Halt(1); END; END; PROCEDURE wdb(VAR textf:Text; vonPart, bisPart:WORD); VAR workstr,s : STRING; fHelpExt : BOOLEAN; iPart, iHelpExt : WORD; BEGIN { Writeln(textf, 'REM Part ',vonPart,'-',bisPart); } workStr := ''; iHelpExt := bisPart + 1; fHelpExt := FALSE; {* Maximale Zeilenl„nge: 2000 Zeichen unter NT *} FOR ipart := vonPart TO bisPart DO BEGIN Str(iPart, s); IF workstr <> '' THEN workStr := workStr + '+ '; workstr := workstr + sBasename+sExt+'.'+s+' /B '; IF (length(workstr) > 170) AND (iPart <> bisPart) THEN BEGIN fHelpExt := true; Writeln(textf, 'copy ',workstr + sBasename+sExt,'.',iHelpExt ); Inc(iHelpExt); workstr := ''; END; END; {- Write the remaining -} IF fHelpExt THEN BEGIN Writeln(textf, 'copy ', workstr + sBasename+sExt+'.',iHelpExt ); Writeln(textf ); wdb( textf, bisPart+1, iHelpExt ); END ELSE Writeln(textf, 'copy ', workstr + sBasename+sExt ); END; PROCEDURE WriteDosBatch(vonPart, bisPart:WORD); VAR sFileName : STRING; textf : Text; BEGIN sFileName := sDir+sBasename+sExt++'.bat'; Writeln( 'writing restore-batch "',sFilename+'" ...'); Assign(TextF, sFilename); { Open output file } ReWrite(textf); IF IOResult <> 0 THEN BEGIN Writeln('Error: could not write file ',sFileName ); Halt(4); END; Writeln(textf, '@echo off' ); wdb(textf, vonPart, bisPart); {* Writeln(textf, 'dir ',sBasename,sExt ); *} Close(textf); END; CONST cMAXBUFSIZE=60000; TYPE t_Buf = array[1..cMAXBUFSIZE] of Char; var pBuf : ^T_Buf; bufSize : Word; textf : Text; FromF, ToF: file; NumRead, NumWritten: LongInt; ipart : WORD; sumWritten, toread, partSize,fromSize : Longint; s: ExtStr; sFileName : STRING; sInFileName : String; begin {$I-} Writeln; if paramcount=0 then begin Writeln('SplitCP - Splitcopy 1.5 (c) dg9ep 1998-2004 *** '); Writeln; Writeln(' splitcp [ | -p.sh (for Unix)'); Writeln(' - .cmd (for OS/2)'); Writeln(' - .bat (for (Win)DOS)'); WriteLn; Halt(7); end; sInFileName := ParamStr(1); Assign(FromF, sInFileNAme ); { Open input file } Reset(FromF, 1); {* Record size = 1 *} IF IOResult <> 0 THEN BEGIN Writeln('splitcp: error - could not open file ',sINFileName); Halt(2); END; fromSize := FileSize(Fromf); IF fromsize = 0 THEN BEGIN WriteLn; Writeln('error: sourcefile-size is zero ',sINFilename ); Halt(5); END; FSplit( sInFileName, sDir, sBasename, sExt); CalcMaxSize(FromSize); partsize := maxsize; Writeln ('splitcp: splitting ',sInFilename,' (',fromsize ,'byte) into ', nPart,' parts'); Writeln (' with a max. part-size of ', maxsize,' byte' ); Writeln; if nPart = 0 THEN BEGIN Writeln('splitcp: error - splitting into 0 parts is not possible'); Halt(6); END; if nPart = 1 THEN BEGIN Writeln('splitcp: error - splitting into 1 part is not necessary'); Halt(6); END; IF MaxAvail <= cMAXBUFSIZE THEN bufSize := MaxAvail ELSE bufSize := cMAXBUFSIZE; GetMem(pBuf,bufSize); FOR ipart := 1 TO nPart DO BEGIN IF iPart=nPart then partSize := fromSize - partsize*(nPart-1); Str(iPart, s); sFilename := sBasename+sExt+'.'+s; Write('copying ', partSize, ' bytes to ',sFilename,' '); sFilename := sDir+sFilename; Assign(ToF, sFileName); { Open output file } Rewrite(ToF, 1); { Record size = 1 } IF IOResult <> 0 THEN BEGIN WriteLn; Writeln('error: could not write file ',sFilename ); Halt(3); END; sumWritten := 0; REPEAT IF sumWritten+bufsize > partsize THEN toRead := partsize-sumWritten ELSE toRead := bufsize; BlockRead(FromF, pBuf^, toread, NumRead); BlockWrite(ToF, pBuf^, NumRead, NumWritten); Inc(SumWritten,NumWritten); IF SumWritten mod 100000 < bufSize THEN Write('.'); UNTIL (NumRead = 0) or (NumWritten <> NumRead) or (sumWritten>=partSize); Writeln; Close(ToF); END; Close(FromF); FreeMem(pBuf,bufSize); pBuf := nil; {----------- DOS -------------------------------------------------------} Writeln; WriteDosBatch(1,nPart); {--------- OS/2 ------------------------------------} sFileName := sDir+sBasename+sExt+'.cmd'; Writeln( 'writing restore-batch "',sFilename+'" ...'); Assign(TextF, sFilename); { Open output file } ReWrite(textf); IF IOResult <> 0 THEN BEGIN Writeln('error: could not write file ',sFileName ); Halt(4); END; Write(Textf, 'copy '); FOR ipart := 1 TO nPart DO BEGIN Str(iPart, s); IF ipart <> 1 THEN Write(textf,'+ '); Write(textf, sBasename+sExt+'.'+s+' /B '); END; Writeln(textf, sBasename+sExt ); Close(textf); {--------- Unix ------------------------------------} sFileName := asLowerCase(sDir+sBasename+sExt)+'.sh'; Writeln( 'writing restore-script "',sFilename+'" ...'); Assign(TextF, sFilename); { Open output file } ReWrite(textf); IF IOResult <> 0 THEN BEGIN Writeln('error: could not write file ',sFileName ); Halt(4); END; Write(Textf, 'cat '); FOR ipart := 1 TO nPart DO BEGIN Str(iPart, s); IF ipart <> 1 THEN Write(textf,' '); Write(textf, asLowerCase(sBasename+sExt)+'.'+s+' '); END; Write(textf, ' > ', asLowerCase(sBasename+sExt) ); Close(textf); Writeln; {-----------------------------------------------------------} Writeln('done!'); Writeln; Halt(0); end.