home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 3
/
hamradioversion3.0examsandprograms1992.iso
/
bbs
/
savemail
/
savemail.pas
< prev
Wrap
Pascal/Delphi Source File
|
1988-03-14
|
2KB
|
98 lines
program Savemail;
uses Dos;
{$I Savefile}
var
Name,
NamR : string[12];
Save_Path,
Path : string;
SRec : SearchRec;
Wc : integer;
procedure PutLead(I : integer);
begin
if I >= 10
then Write(I:2)
else Write('0',I:1)
end; { of procedure PutLead }
procedure PutDateTime(DT : DateTime);
var
H : Integer;
Ch : char;
begin
with DT do begin
Write(Month:2,'-');
PutLead(Day); Write('-');
PutLead(Year mod 100); Write(' ');
if Hour >= 12
then Ch := 'p'
else Ch := 'a';
H := Hour mod 12;
if H = 0
then H := 12;
Write(H:2,':');
PutLead(Min); Write(Ch)
end
end; { of procedure PutDateTime }
procedure PutName(Name : string);
var
DotPos : integer;
Ext : string[3];
begin
NamR := Name;
DotPos := Pos('.',Name);
if DotPos <> 0 then begin
Ext := Copy(Name,DotPos+1,Length(Name)-DotPos);
Delete(Name,DotPos,1+Length(Name)-DotPos)
end
else Ext := '';
Write(Name,' ':(10-Length(Name)),Ext,' ':(5-Length(Ext)))
end; { of procedure PutName }
procedure PutSRec(SRec : SearchRec);
var
DT : DateTime;
begin
with SRec do begin
PutName(Name);
if (Attr and Directory) <> 0
then Write(' <DIR>')
else begin
Write(Size:10,' ');
UnpackTime(Time,DT);
PutDateTime(DT)
end;
WriteLn
end
end; { of procedure PutSRec }
begin
Wc := 0;
repeat
Write('Enter path name: '); Readln(Path);
Write('Enter path for saved files: ');ReadLn(Save_Path);
Writeln('Screening ',Path,' -- Copying to ',Save_Path);
If Path <> '' then begin
FindFirst(Path,AnyFile,SRec);
while DosError = 0 do begin
PutSRec(SRec);
FindNext(SRec);
SaveFile(NamR,Save_Path,Wc)
end;
WriteLn
end
until Path = '';
WriteLn(' The number of Weather Messages was ', Wc)
end. { of program Savemail }