Category : Files from Magazines
Archive   : ITP9001.ZIP
Filename : LOCATION.PAS

{ Turbo Pascal Location Example }

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;
writeln( 'Specification format: [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.