home *** CD-ROM | disk | FTP | other *** search
- Program Test;
- {$F+}
-
- { FILE: TEST.PAS
-
- Purpose: A test program to test the Win32 API calls in TPW32.PAS
-
- History:
- first version
- 15 November 1995, Dr A Olowofoyeku
- }
-
- uses
- WinTypes,
- WinDos,
- Strings,
- W32Types,
- TPW32,
- WinCrt;
-
- {/////////////////////////////////////////////////////////}
- Function Pad(s:string;const len:byte):string;
- {very crude function to pad a string with blanks, up
- to length "len"}
- var
- i,j:byte;
- begin
- pad:=s;
- j:=length(s);
- if j>=len then exit;
- for i:=j to pred(len) do s:=s+' ';
- pad:=s;
- end;
- {/////////////////////////////////////////////////////////}
- Procedure MyProc(Var sR:T32SearchRec);far;
- {callback procedure for LocateFiles() }
- Begin
- Write(Pad(Strpas(sr.Name),12),' = ',pad(strpas(sr.lname),20));
-
- if (sr.attr and fadirectory<>0)
- then write(' [DIR]') else Write(' [',sr.Attr,'] ');
-
- Writeln(' ',sr.Size:8,' bytes');
- End;
- {/////////////////////////////////////////////////////////}
- {/////////////////////////////////////////////////////////}
- {/////////////////////////////////////////////////////////}
- var
- p : array[0..259] of char;
- sR : T32SearchRec;
- ms : memorystatus;
-
- begin
- {initialise WinCrt screen}
- windoworg.x:=1;
- windoworg.y:=1;
- screensize.x:=120;
- screensize.y:=250;
- windowsize.x:=700;
- windowsize.y:=550;
- Strpcopy(WindowTitle,' Sample Win32 API Program: by The African Chief');
- {see whether Win32 initialised correctly}
- writeln('Win32 Init Status = ',IsWin32OS);
-
-
- {get system memory information}
- Writeln;
- With Ms do begin
- dwlength:=sizeof(memorystatus); {initialise the memory structure}
- GlobalMemoryStatus(ms); {get memory info}
-
- Writeln('System memory in use : ',dwMemoryLoad,'%');
- Writeln('Total physical memory: ',dwTotalPhys,' bytes');
- Writeln('Free physical memory: ',dwAvailPhys,' bytes');
- Writeln('Total page file : ',dwTotalPageFile,' bytes');
- Writeln('Free page file : ',dwAvailPageFile,' bytes');
- Writeln('Total virtual memory : ',dwTotalVirtual,' bytes');
- Writeln('Free virtual memory : ',dwAvailVirtual,' bytes');
- end;
-
- {see the drive types }
- Writeln;
- writeln('Drive A: = ',DriveTypes[GetDriveType('A:\')],' drive');
- writeln('Drive B: = ',DriveTypes[GetDriveType('B:\')],' drive');
- writeln('Drive C: = ',DriveTypes[GetDriveType('C:\')],' drive');
- writeln('Drive D: = ',DriveTypes[GetDriveType('D:\')],' drive');
- writeln('Drive E: = ',DriveTypes[GetDriveType('E:\')],' drive');
- writeln('Drive F: = ',DriveTypes[GetDriveType('F:\')],' drive');
- writeln('Drive G: = ',DriveTypes[GetDriveType('G:\')],' drive');
-
- writeln;
-
- {some sundry information}
- Writeln('The current directory is: ',W32ShowDir);
- Writeln('The current drive is : ',ThisDrive);
- Writeln('\WIN95 is on this drive : ',ExistFileOrDirectory('\WIN95'));
- Writeln('Your Windows is in : ',GetEnv('windir'));
- Writeln('PATH = ',GetEnv('path'));
-
- {other stuff}
- Writeln;
- while TRUE=TRUE do {endless loop until "q" is entered}
- begin
- {let's find some file names}
- write('Enter a File Spec: ');
- readln(p);
- if Strpas(p)='q' then donewincrt;
-
- { - these lines are the same as a call to LocateFile, below -
- W32FindFirst(p, faAnyFile, sR);
- While DosError=0 do begin
- MyProc(sR);
- W32FindNext(sR);
- end;
- }
- LocateFiles(p, faAnyFile, sR, MyProc);
-
- {let's run a program}
- writeln;
- write('Enter a Program name: ');
- readln(p);
- if (Strpas(p)='q') or (strlen(p)=0)then donewincrt;
- W32WinExec(p,sw_Normal);
- end;
- end.
-