home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 31
/
CDASC_31_1996_juillet_aout.iso
/
internet
/
rnr214.zip
/
GETFNAME.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-02-02
|
31KB
|
1,316 lines
program getfname;
{
Russell_Schulz@locutus.ofB.ORG (960202)
Copyright 1996 Russell Schulz
this code is not in the Public Domain
permission is granted to use these routines in any application regardless
of commercial status as long as the author of these routines assumes no
liability for any damages whatsoever for any reason. have fun.
}
uses dos,crt,genericf,linedraw;
const
esc=#27;
shiftedtab=#209; {this is _ugly_}
altf=#210; {this is _ugly_}
altp=#211; {this is _ugly_}
altd=#212; {this is _ugly_}
alto=#213; {this is _ugly_}
altc=#214; {this is _ugly_}
type
filenamet=string[12]; {8.3}
datetimet=string[16]; {YYYY-MM-DD HH:MM}
filenodep=^filenode;
filenode=
record
filename: filenamet;
datetime: datetimet;
size: longint;
next: filenodep;
end;
var
outputfn: string;
title: string;
filemustexist: boolean;
maxtofind: integer;
warnifexists: boolean;
allowmkdir: boolean;
pattern: string;
currpath: string;
driveletters: string;
vikeys: boolean;
dialogx,dialogy: integer;
dialogwidth,dialogheight: integer;
oldtextattr: byte;
outputf: text;
labels: array[1..26] of string;
filehead: filenodep;
pathhead: filenodep;
drivehead: filenodep;
reusehead: filenodep;
titlwithpath: string;
resultingfn: string;
underdialog: savedbytes;
startupx,startupy: integer;
procedure usage;
begin
writeln('usage: getfname [options] required');
writeln;
writeln('required:');
writeln(' -o output-filename');
writeln;
writeln('options:');
writeln(' -t title');
writeln(' -e file must exist');
writeln(' -m maximum # of files to return (now can only be 1)');
writeln(' -w warn if it exists');
writeln(' -i initial pattern');
writeln(' -n don''t allow mkdir');
writeln(' -p path to start in');
writeln(' -d drive letters to check (e.g., CDZ)');
writeln(' -v use vi keys (j and k; but not ^F and ^B, sorry)');
writeln;
writeln('Russell_Schulz@locutus.ofB.ORG (960202)');
halt(1);
end;
procedure msgusage(s: string);
begin
writeln(s);
usage;
end;
function withzero(i: integer): string;
begin
withzero := chr(ord('0')+(i div 10))+chr(ord('0')+(i mod 10));
end;
function withoutlastdir(apath: string): string;
var
result: string;
newlength: integer;
tempint: integer;
begin
result := apath;
if numoccur('\',withbackslash(result))>1 then
begin
newlength := length(result); {not needed}
for tempint := 1 to length(result) do
if result[tempint]='\' then
newlength := tempint-1;
result := copy(result,1,newlength);
if right(result,1)=':' then
result := result+'\';
end;
{
if right(result,1)='\' then
if length(result)>1 then
if right(result,2)<>':\' then
result := copy(result,1,length(result)-1);
}
withoutlastdir := result;
end;
function unlabel(labelfn: string): string;
begin
unlabel := copy(labelfn,1,8)+copy(labelfn,10,255); {skip the implied .}
end;
function prevptr(aptr: filenodep; ahead: filenodep): filenodep;
var
result: filenodep;
found: boolean;
begin
result := ahead;
found := false;
while (result<>nil) and not found do
begin
if result^.next=aptr then
found := true
else
result := result^.next;
end;
{
if not found then
writeln('internal error: could not find prev');
}
prevptr := result;
end;
procedure sortlist(var ahead: filenodep);
var
newhead: filenodep;
lastsofar: filenodep;
lastnamesofar: filenamet;
prevtolast: filenodep;
current: filenodep;
begin
newhead := nil;
while ahead<>nil do
begin
lastsofar := ahead;
lastnamesofar := ahead^.filename;
current := lastsofar^.next;
while current<>nil do
begin
if current^.filename>lastnamesofar then
begin
lastsofar := current;
lastnamesofar := current^.filename;
end;
current := current^.next;
end;
{remove from list}
if lastsofar=ahead then
ahead := ahead^.next
else
begin
prevtolast := prevptr(lastsofar,ahead);
prevtolast^.next := lastsofar^.next;
end;
{add to new head}
lastsofar^.next := newhead;
newhead := lastsofar;
end;
ahead := newhead;
end;
procedure reversevideo;
begin
textattr := black+white*8;
{
textcolor(red);
}
end;
procedure enhancedvideo;
begin
textattr := blue;
{
textcolor(blue);
}
end;
procedure normalvideo;
begin
textattr := oldtextattr;
{
textcolor(white);
}
end;
procedure reuse(var ahead: filenodep);
var
aptr: filenodep;
begin
if reusehead=nil then
reusehead := ahead
else
begin
aptr := reusehead;
while aptr^.next<>nil do
aptr := aptr^.next;
aptr^.next := ahead;
end;
ahead := nil;
end;
function xreadkey: char;
var
result: char;
begin
result := readkey;
{$define pgdnbecomesgt}
{ change these extended keys: }
{ 2nd Char key pressed code returned }
{ -------- ----------- ------------- }
{ I 73 PgUp < }
{ Q 81 PgDn space (or >) }
{ G 71 Home ^A (or ^) }
{ O 79 End ^E (or $) }
{ ; 59 F1 ? }
{ K 75 left arrow ^B (or backspace) }
{ M 77 right arrow ^F }
{ H 72 up arrow ^P }
{ P 80 down arrow ^N }
{ S 83 del ^D }
{ 15 shift-TAB shiftedtab (209) }
{ misc alt-letter misc. codes >209 }
if (result=#0) and keypressed then
begin
result := readkey;
if result='I' then
result := '<'
else if result='Q' then
{$ifdef pgdnbecomesgt}
result := '>'
{$else}
result := ' '
{$endif}
else if result='G' then
{$ifdef homebecomescarat}
result := '^'
{$else}
result := ^A
{$endif}
else if result='O' then
{$ifdef endbecomesdollar}
result := '$'
{$else}
result := ^E
{$endif}
else if result=';' then
result := '?'
else if result='K' then
{$ifdef leftbecomesbackspace}
result := #8
{$else}
result := ^B
{$endif}
else if result='M' then
result := ^F
else if result='H' then
result := ^P
else if result='P' then
result := ^N
else if result='S' then
result := ^D
else if result=#15 then
result := shiftedtab
else if result=#33 then
result := altf
else if result=#25 then
result := altp
else if result=#32 then
result := altd
else if result=#24 then
result := alto
else if result=#46 then
result := altc
else
{ ignore other extended keys }
result := #0;
end;
xreadkey := result;
end;
procedure initialize;
var
currparami: integer;
currparams: string;
nextparams: string;
begin
oldtextattr := textattr;
startupx := wherex;
startupy := wherey;
if paramcount=0 then
usage;
outputfn := '';
title := 'Open';
filemustexist := false;
maxtofind := 1;
warnifexists := false;
allowmkdir := true;
pattern := '*.*';
currpath := '';
{ driveletters := 'abcdefghijklmnopqrstuvwxyz'; }
driveletters := 'cdefghijklmnopqrstuvwxyz';
vikeys := false;
dialogx := 2;
dialogy := 2;
dialogwidth := 74;
dialogheight := 20;
currparami := 1;
while currparami<=paramcount do
begin
currparams := paramstr(currparami);
if currparami<paramcount then
nextparams := paramstr(currparami+1)
else
nextparams := '';
if currparams='-?' then
usage
else if currparams='-o' then
begin
if nextparams='' then
msgusage('-o requires a filename');
outputfn := nextparams;
inc(currparami);
end
else if currparams='-t' then
begin
if nextparams='' then
msgusage('-t requires a string');
title := nextparams;
inc(currparami);
end
else if currparams='-e' then
begin
filemustexist := true;
end
else if currparams='-m' then
begin
if nextparams='' then
msgusage('-m requires an integer');
maxtofind := atoi(nextparams);
if maxtofind=0 then
msgusage('-m requires an integer');
inc(currparami);
end
else if currparams='-w' then
begin
warnifexists := true;
end
else if currparams='-n' then
begin
allowmkdir := false;
end
else if currparams='-i' then
begin
if nextparams='' then
msgusage('-i requires a pattern');
pattern := nextparams;
inc(currparami);
end
else if currparams='-p' then
begin
if nextparams='' then
msgusage('-p requires a path');
currpath := nextparams;
inc(currparami);
end
else if currparams='-d' then
begin
if nextparams='' then
msgusage('-d requires a list of letters');
driveletters := nextparams;
inc(currparami);
end
else if currparams='-v' then
begin
vikeys := true;
end
else
msgusage('unknown parameter: '+currparams);
inc(currparami);
end;
if outputfn='' then
msgusage('-o is required');
if currpath='' then
begin
{set path to current}
getdir(0,currpath);
currpath := lower(currpath);
end;
if right(currpath,1)=':' then
begin
{set path to current}
getdir(1+ord(upcase(currpath[1]))-ord('A'),currpath);
currpath := lower(currpath);
end;
assign(outputf,outputfn);
{$I-}
rewrite(outputf);
{$I+}
if ioresult<>0 then
msgusage('could not write to '+outputfn);
resultingfn := '';
reusehead := nil;
end;
function getnewptr: filenodep;
var
result: filenodep;
begin
if reusehead<>nil then
begin
result := reusehead;
reusehead := reusehead^.next;
end
else
begin
if memavail<10240 then
result := nil
else
new(result);
end;
getnewptr := result;
end;
function longintdatetostring(time: longint): string;
var
result: string;
dt: datetime;
begin
unpacktime(time,dt);
result := wtoa(dt.year)+'-'+withzero(dt.month)+'-'+withzero(dt.day)+' '+
withzero(dt.hour)+':'+withzero(dt.min);
longintdatetostring := result;
end;
function insertedptrathead(var ahead: filenodep; filename: string;
datetime: string; size: longint): boolean;
var
result: boolean;
newptr: filenodep;
begin
result := true;
newptr := getnewptr;
if newptr=nil then
begin
result := false;
{}{}{}{}{} {need to handle out-of-memory better than this}
gotoxy(1,1);
writeln('out of memory');
end
else
begin
newptr^.next := ahead;
ahead := newptr;
newptr^.filename := filename;
newptr^.datetime := datetime;
newptr^.size := size;
end;
insertedptrathead := result;
end;
procedure initializedir;
var
fileinfo: searchrec;
done: boolean;
begin
staticpopup(10,10,'Searching directory...');
reuse(filehead);
reuse(pathhead);
findfirst(withbackslash(currpath)+pattern,directory,fileinfo);
done := (doserror<>0);
while not done do
begin
if (fileinfo.attr and directory)=0 then
begin
done := not
insertedptrathead(filehead,
lower(fileinfo.name),
longintdatetostring(fileinfo.time),
fileinfo.size);
end
else
begin
if (fileinfo.name<>'.') and (fileinfo.name<>'..') then
done :=
not insertedptrathead(pathhead,lower(fileinfo.name),'',0);
end;
if not done then
begin
findnext(fileinfo);
done := (doserror<>0);
end;
end;
sortlist(filehead);
sortlist(pathhead);
{
need to add it in by hand since our Netware 4.1 drive doesn't
list . or .. (I don't know why!)
}
if right(currpath,2)<>':\' then
begin
{just assign to `done' -- not used}
done := not insertedptrathead(pathhead,'..','',0);
end;
removepopup;
end;
procedure initializedrivelist;
var
whichdisk: integer;
done: boolean;
fileinfo: searchrec;
begin
staticpopup(10,10,'Finding valid drives...');
reuse(drivehead);
done := false;
for whichdisk := 26 downto 1 do
begin
labels[whichdisk] := '';
if not done then
if pos(chr(ord('A')+whichdisk-1),upper(driveletters))<>0 then
if diskfree(whichdisk)>=0 then
begin
labels[whichdisk] := chr(ord('A')+whichdisk-1)+':';
findfirst(labels[whichdisk]+'\*.*',volumeid,fileinfo);
if doserror=0 then
labels[whichdisk] :=
labels[whichdisk]+' '+lower(unlabel(fileinfo.name));
done := not
insertedptrathead(drivehead,
labels[whichdisk],
'',
diskfree(whichdisk));
end;
end;
removepopup;
end;
{$ifdef old}
procedure saveunderdialog;
var
anx,any: integer;
regs: registers;
begin
underdialog.count := 0;
for anx := dialogx to dialogx+dialogwidth-1 do
for any := dialogy to dialogy+dialogheight-1 do
if underdialog.count<maxsavedbytes-1 then
begin
gotoxy(anx,any);
{read character+attribute from screen}
regs.ah := 8;
regs.bh := 0;
intr($10,regs);
{first character, then attribute}
inc(underdialog.count);
underdialog.buffer[underdialog.count] := chr(regs.al);
inc(underdialog.count);
underdialog.buffer[underdialog.count] := chr(regs.ah);
end;
end;
procedure restoreunderdialog;
var
anx,any: integer;
currbyte: integer;
regs: registers;
begin
currbyte := 0;
for anx := dialogx to dialogx+dialogwidth-1 do
for any := dialogy to dialogy+dialogheight-1 do
if currbyte<underdialog.count then
begin
gotoxy(anx,any);
{first character, then attribute}
inc(currbyte);
regs.al := ord(underdialog.buffer[currbyte]);
inc(currbyte);
regs.bl := ord(underdialog.buffer[currbyte]);
{write character+attribute to screen}
regs.ah := 9;
regs.bh := 0;
regs.cx := 1;
intr($10,regs);
end;
end;
{$endif}
procedure updatedialogtitle(newpath: string);
var
titlewithpath: string;
begin
singleboxwh(dialogx,dialogy,dialogwidth,dialogheight);
titlewithpath := title+' - '+newpath;
writexys(dialogx+1,dialogy,titlewithpath);
end;
procedure displaydialogoutline;
begin
singleboxwh(dialogx,dialogy,dialogwidth,dialogheight);
emptyboxwh(dialogx,dialogy,dialogwidth,dialogheight);
{
writexys(dialogx+1,dialogy,title);
updatedialogtitle(title);
}
end;
procedure fancyboxwh(isfancy: boolean; leftx,topy,width,height: integer);
begin
if isfancy then
begin
enhancedvideo;
doubleboxwh(leftx,topy,width,height);
normalvideo;
end
else
begin
normalvideo;
singleboxwh(leftx,topy,width,height);
normalvideo;
end;
end;
procedure displayfilepartoutline(isselected: boolean);
begin
if isselected then
doubleboxwh(dialogx+1,dialogy+1,44,dialogheight-2)
else
singleboxwh(dialogx+1,dialogy+1,44,dialogheight-2);
writexys(dialogx+2,dialogy+1,'File');
end;
procedure displaypathpartoutline(isselected: boolean);
begin
if isselected then
doubleboxwh(dialogx+45,dialogy+1,dialogwidth-2-45,10)
else
singleboxwh(dialogx+45,dialogy+1,dialogwidth-2-45,10);
writexys(dialogx+46,dialogy+1,'Path');
end;
procedure displaydrivepartoutline(isselected: boolean);
begin
if isselected then
doubleboxwh(dialogx+45,dialogy+10+1,dialogwidth-2-45,dialogheight-2-10-2)
else
singleboxwh(dialogx+45,dialogy+10+1,dialogwidth-2-45,dialogheight-2-10-2);
writexys(dialogx+46,dialogy+10+1,'Drive');
end;
procedure displayokoutline(isselected: boolean);
begin
if isselected then
doubleboxwh(dialogx+45,dialogy+dialogheight-3,10,2)
else
singleboxwh(dialogx+45,dialogy+dialogheight-3,10,2);
writexys(dialogx+46,dialogy+dialogheight-3,'OK');
end;
procedure displaycanceloutline(isselected: boolean);
begin
if isselected then
doubleboxwh(dialogx+55,dialogy+dialogheight-3,10,2)
else
singleboxwh(dialogx+55,dialogy+dialogheight-3,10,2);
writexys(dialogx+56,dialogy+dialogheight-3,'Cancel');
end;
procedure updatefilepart(startptr: filenodep);
var
aptr: filenodep;
curry: integer;
begin
emptyboxwh(dialogx+1,dialogy+1,44,dialogheight-2);
curry := dialogy+2;
aptr := startptr;
while (aptr<>nil) and (curry<dialogy+dialogheight-2) do
begin
if aptr=startptr then
reversevideo;
writexys(dialogx+3,curry,leftjustify(aptr^.filename,12,' '));
write(' ',aptr^.datetime);
write(' ',rightjustify(ltoa(aptr^.size div 1024),9,' '),'k');
normalvideo;
aptr := aptr^.next;
inc(curry);
end;
{
gotoxy(dialogx+2,dialogy+2);
}
end;
procedure updatepathpart(startptr: filenodep);
var
aptr: filenodep;
curry: integer;
{
mangledcurrpath: string;
partofpath: string;
}
begin
emptyboxwh(dialogx+45,dialogy+1,dialogwidth-2-45,10);
curry := dialogy+2;
{
mangledcurrpath := withbackslash(currpath);
while (mangledcurrpath<>'') and (curry<dialogy+10) do
begin
partofpath := copy(mangledcurrpath,1,pos('\',mangledcurrpath));
mangledcurrpath := copy(mangledcurrpath,length(partofpath)+1,255);
writexys(dialogx+45+2,curry,leftjustify(partofpath,12,' '));
inc(curry);
end;
}
aptr := startptr;
while (aptr<>nil) and (curry<dialogy+10) do
begin
{}{}{}{} {want to show the tree so far non-indented}
if aptr=startptr then
reversevideo;
{indent 3}
writexys(dialogx+45+2+3,curry,leftjustify(aptr^.filename,12,' '));
{
write(' ',aptr^.datetime);
write(' ',rightjustify(ltoa(aptr^.size div 1024),9,' '),'k');
}
normalvideo;
aptr := aptr^.next;
inc(curry);
end;
{
gotoxy(dialogx+45+1,dialogy+1+1);
}
end;
procedure updatedrivepart(startptr: filenodep);
var
aptr: filenodep;
curry: integer;
begin
emptyboxwh(dialogx+45,dialogy+10+1,dialogwidth-2-45,dialogheight-2-10-2);
curry := dialogy+10+2;
aptr := startptr;
while (aptr<>nil) and (curry<dialogy+dialogheight-2-1-1) do
begin
if aptr=startptr then
reversevideo;
writexys(dialogx+46,curry,leftjustify(aptr^.filename,12,' '));
{
write(' ',aptr^.datetime);
}
write(' ',
rightjustify(ltoa((aptr^.size+1024*1024-1) div 1024 div 1024),9,' '),
'M');
normalvideo;
aptr := aptr^.next;
inc(curry);
end;
{
gotoxy(dialogx+2,dialogy+2);
}
end;
procedure maybeincptr(var aptr: filenodep; count: integer);
var
tempint: integer;
begin
for tempint := 1 to count do
if aptr^.next<>nil then
aptr := aptr^.next;
end;
procedure maybedecptr(var aptr: filenodep; ahead: filenodep; count: integer);
var
tempint: integer;
begin
for tempint := 1 to count do
if prevptr(aptr,ahead)<>nil then
aptr := prevptr(aptr,ahead);
end;
procedure process;
type
showingt=
(
onfirst,
onfilepart,
onpathpart,
ondrivepart,
onok,
oncancel,
onlast
);
var
currfileptr: filenodep;
currpathptr: filenodep;
currdriveptr: filenodep;
done: boolean;
onekey: char;
showing: showingt;
begin
drivehead := nil;
initializedrivelist;
saveareawh(dialogx,dialogy,dialogwidth,dialogheight,underdialog);
displaydialogoutline;
showing := onfilepart;
displayfilepartoutline(showing=onfilepart);
displaypathpartoutline(showing=onpathpart);
displaydrivepartoutline(showing=ondrivepart);
displayokoutline(showing=onok);
displaycanceloutline(showing=oncancel);
filehead := nil;
pathhead := nil;
initializedir;
currfileptr := filehead;
currpathptr := pathhead;
currdriveptr := drivehead;
updatefilepart(currfileptr);
updatepathpart(currpathptr);
updatedrivepart(currdriveptr);
updatedialogtitle(currpath);
done := false;
while not done do
begin
case showing of
onfilepart: updatefilepart(currfileptr);
onpathpart: updatepathpart(currpathptr);
ondrivepart: updatedrivepart(currdriveptr);
else
begin end;
end;
onekey := xreadkey;
if onekey=tab then
begin
showing := succ(showing);
if showing=onlast then
showing := succ(onfirst);
displayfilepartoutline(showing=onfilepart);
displaypathpartoutline(showing=onpathpart);
displaydrivepartoutline(showing=ondrivepart);
displayokoutline(showing=onok);
displaycanceloutline(showing=oncancel);
end
else if onekey=shiftedtab then
begin
showing := pred(showing);
if showing=onfirst then
showing := pred(onlast);
displayfilepartoutline(showing=onfilepart);
displaypathpartoutline(showing=onpathpart);
displaydrivepartoutline(showing=ondrivepart);
displayokoutline(showing=onok);
displaycanceloutline(showing=oncancel);
end
else if onekey=altf then
begin
showing := onfilepart;
displayfilepartoutline(showing=onfilepart);
displaypathpartoutline(showing=onpathpart);
displaydrivepartoutline(showing=ondrivepart);
displayokoutline(showing=onok);
displaycanceloutline(showing=oncancel);
end
else if onekey=altp then
begin
showing := onpathpart;
displayfilepartoutline(showing=onfilepart);
displaypathpartoutline(showing=onpathpart);
displaydrivepartoutline(showing=ondrivepart);
displayokoutline(showing=onok);
displaycanceloutline(showing=oncancel);
end
else if onekey=altd then
begin
showing := ondrivepart;
displayfilepartoutline(showing=onfilepart);
displaypathpartoutline(showing=onpathpart);
displaydrivepartoutline(showing=ondrivepart);
displayokoutline(showing=onok);
displaycanceloutline(showing=oncancel);
end
else if onekey=alto then
begin
{}{}{}{} {they might have typed in a new filename}
resultingfn := withbackslash(currpath)+currfileptr^.filename;
done := true
end
else if onekey=altc then
begin
done := true;
end
else if onekey=esc then
begin
done := true;
end
else
case showing of
onfilepart:
begin
if onekey=#13 then
begin
if currfileptr<>nil then
begin
{}{}{}{} {they might have typed in a new filename}
resultingfn :=
withbackslash(currpath)+currfileptr^.filename;
done := true
end;
end
else if onekey=^N then
begin
maybeincptr(currfileptr,1);
end
else if vikeys and (onekey='j') then
begin
maybeincptr(currfileptr,1);
end
else if onekey=^P then
begin
maybedecptr(currfileptr,filehead,1);
end
else if vikeys and (onekey='k') then
begin
maybedecptr(currfileptr,filehead,1);
end
else if onekey='>' then
begin
maybeincptr(currfileptr,15);
end
else if onekey='<' then
begin
maybedecptr(currfileptr,filehead,15);
end
else if onekey=^E then
begin
while currfileptr^.next<>nil do
currfileptr := currfileptr^.next;
end
else if onekey=^A then
begin
currfileptr := filehead;
end
else
begin
{}
end;
end;
onpathpart:
begin
if onekey=#13 then
begin
if currpathptr<>nil then
begin
if currpathptr^.filename='..' then
currpath := withoutlastdir(currpath)
else
currpath :=
withbackslash(currpath)+currpathptr^.filename;
initializedir;
currfileptr := filehead;
currpathptr := pathhead;
updatefilepart(currfileptr);
updatepathpart(currpathptr);
updatedialogtitle(currpath);
end;
end
else if onekey=^N then
begin
maybeincptr(currpathptr,1);
end
else if vikeys and (onekey='j') then
begin
maybeincptr(currpathptr,1);
end
else if onekey=^P then
begin
maybedecptr(currpathptr,pathhead,1);
end
else if vikeys and (onekey='k') then
begin
maybedecptr(currpathptr,pathhead,1);
end
else if onekey='>' then
begin
maybeincptr(currpathptr,7);
end
else if onekey='<' then
begin
maybedecptr(currpathptr,pathhead,7);
end
else if onekey=^E then
begin
while currpathptr^.next<>nil do
currpathptr := currpathptr^.next;
end
else if onekey=^A then
begin
currpathptr := pathhead;
end
else
begin
{}
end;
end;
ondrivepart:
begin
if onekey=#13 then
begin
if currdriveptr<>nil then
begin
getdir(1+ord(upcase(currdriveptr^.filename[1]))-ord('A'),
currpath);
currpath := lower(currpath);
initializedir;
currfileptr := filehead;
currpathptr := pathhead;
updatefilepart(currfileptr);
updatepathpart(currpathptr);
updatedrivepart(currdriveptr);
updatedialogtitle(currpath);
end;
end
else if onekey=^N then
begin
maybeincptr(currdriveptr,1);
end
else if vikeys and (onekey='j') then
begin
maybeincptr(currdriveptr,1);
end
else if onekey=^P then
begin
maybedecptr(currdriveptr,drivehead,1);
end
else if vikeys and (onekey='k') then
begin
maybedecptr(currdriveptr,drivehead,1);
end
else if onekey='>' then
begin
maybeincptr(currdriveptr,3);
end
else if onekey='<' then
begin
maybedecptr(currdriveptr,drivehead,3);
end
else if onekey=^E then
begin
while currdriveptr^.next<>nil do
currdriveptr := currdriveptr^.next;
end
else if onekey=^A then
begin
currdriveptr := drivehead;
end
else
begin
{}
end;
end;
onok:
begin
if onekey=#13 then
begin
if currfileptr<>nil then
begin
{}{}{}{} {they might have typed in a new filename}
resultingfn :=
withbackslash(currpath)+currfileptr^.filename;
done := true;
end;
end
else if onekey=' ' then
begin
if currfileptr<>nil then
begin
{}{}{}{} {they might have typed in a new filename}
resultingfn :=
withbackslash(currpath)+currfileptr^.filename;
done := true;
end;
end
else
begin
{}
end;
end;
oncancel:
begin
if onekey=#13 then
begin
done := true;
end
else if onekey=' ' then
begin
done := true;
end
else
begin
{}
end;
end;
end;
end;
restorearea(underdialog);
end;
procedure shutdown;
begin
if resultingfn<>'' then
writeln(outputf,resultingfn);
close(outputf);
gotoxy(startupx,startupy);
textattr := oldtextattr;
end;
begin
initialize;
process;
shutdown;
end.