home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
insidetp
/
1990_01
/
location.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-12-15
|
3KB
|
124 lines
{ Turbo Pascal Location Example }
PROGRAM Location;
USES Dos, Crt;
CONST
DataPath =
'NOT ASSIGNED !!!!!!!!!!!!!!!!!!!!';
TYPE
DataBlock = ARRAY[1..256] OF Byte;
VAR
CurrPath, NewPath : PathStr;
Dir : DirStr;
Name : NameStr;
Ext : ExtStr;
PROCEDURE ReplaceSpec(CurrPath, SearchSpec,
NewSpec : PathStr);
VAR
InF, OutF : FILE;
OutPath, EmptyStr : PathStr;
Result1, Result2 : Word;
i, j, SearchLen : Integer;
SearchArray : ARRAY[1..128] OF Byte;
EndFlag, BlkDone,
SearchResult, Changes : boolean;
FileBlock1, FileBlock2 : DataBlock;
BEGIN
FillChar(EmptyStr, SizeOf(EmptyStr), ' ');
FOR i := 1 TO Ord(NewSpec[0]) DO
NewSpec[i] := UpCase(NewSpec[i]);
NewSpec := copy(NewSpec+EmptyStr, 1,
SizeOf(SearchSpec));
SearchLen := Ord(SearchSpec[0]);
FOR i := 1 TO SearchLen DO
SearchArray[i] := Ord(SearchSpec[i]);
Assign(InF, CurrPath);
{$I-} Reset(InF, 1); {$I+}
IF IOResult = 0 THEN
BEGIN
FSplit(CurrPath, Dir, Name, Ext);
OutPath := Dir + Name + '.NEW';
Assign(OutF, OutPath);
Rewrite(OutF, 1);
EndFlag := FALSE;
BlkDone := FALSE;
SearchResult := FALSE;
Changes := FALSE;
BlockRead(InF, FileBlock2,
SizeOf(FileBlock2), Result2);
EndFlag := Result2 <> SizeOf(FileBlock2);
REPEAT
FileBlock1 := FileBlock2;
Result1 := Result2;
FOR i := 1 TO SizeOf(FileBlock2) DO
FileBlock2[i] := $00;
IF NOT EndFlag THEN
BEGIN
BlockRead(InF, FileBlock2,
SizeOf(FileBlock2), Result2);
EndFlag := Result2 <> SizeOf(FileBlock2);
END
ELSE
BlkDone := TRUE;
IF NOT SearchResult THEN
FOR i := 1 TO Result1 DO
IF SearchArray[1] = FileBlock1[i] THEN
BEGIN
FOR j := 1 TO SearchLen DO
BEGIN
IF i+j-1 <= Result1
THEN SearchResult :=
SearchArray[j] = FileBlock1[i+j-1]
ELSE SearchResult :=
SearchArray[j] =
FileBlock2[i+j-257];
IF NOT SearchResult THEN
j := SearchLen;
END;
IF SearchResult THEN
FOR j := 1 TO SearchLen DO
IF i+j-1 <= Result1
THEN FileBlock1[i+j-1] :=
Ord(NewSpec[j])
ELSE FileBlock2[i+j-257] :=
Ord(NewSpec[j]);
END;
BlockWrite(OutF, FileBlock1,
Result1, Result1);
UNTIL BlkDone;
Close(OutF);
Close(InF);
erase(InF);
rename(OutF, Name+'.EXE');
END
ELSE
WriteLn(CurrPath, ' invalid file name!');
END;
BEGIN
CurrPath := FExpand('LOCATION.EXE');
ClrScr;
WriteLn('CurrPath = ', CurrPath);
WriteLn('DataPath = ', DataPath);
WriteLn;
Write('Specification format: ');
WriteLn('[d:\][path1\][path2\] ... ');
Write('Enter filepath specification: ');
ReadLn(NewPath);
IF NewPath <> '' THEN
BEGIN
FSplit(NewPath, Dir, Name, Ext);
NewPath := Dir;
WriteLn('New filepath = ', NewPath);
IF NewPath <> '' THEN
ReplaceSpec(CurrPath, DataPath, NewPath);
END;
GotoXY(1, 25); clreol;
Write('Press any key to continue: ');
WHILE NOT KeyPressed DO;
END.