home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / zkuste / delphi / ruzkomp / APITHING.ZIP / MyComponent.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-09-14  |  11.8 KB  |  367 lines
  1. unit MyComponent;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, ShellAPI, tvAPIThing;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Button1: TButton;
  12.     Button2: TButton;
  13.     Button3: TButton;
  14.     Button4: TButton;
  15.     Button5: TButton;
  16.     Button6: TButton;
  17.     Button7: TButton;
  18.     Button8: TButton;
  19.     Button9: TButton;
  20.     Button10: TButton;
  21.     Timer1: TTimer;
  22.     Button11: TButton;
  23.     Button12: TButton;
  24.     Panel1: TPanel;
  25.     Image1: TImage;
  26.     Button13: TButton;
  27.     Label1: TLabel;
  28.     Button14: TButton;
  29.     Button15: TButton;
  30.     Button16: TButton;
  31.     Button18: TButton;
  32.     Button19: TButton;
  33.     Button20: TButton;
  34.     Button21: TButton;
  35.     Button17: TButton;
  36.     Button22: TButton;
  37.     Button23: TButton;
  38.     Button24: TButton;
  39.     Button25: TButton;
  40.     APIThing: TtvAPIThing;
  41.  
  42.     procedure Button1Click(Sender: TObject);
  43.     procedure FormCreate(Sender: TObject);
  44.     procedure Button2Click(Sender: TObject);
  45.     procedure Button3Click(Sender: TObject);
  46.     procedure Button4Click(Sender: TObject);
  47.     procedure Button5Click(Sender: TObject);
  48.     procedure Button6Click(Sender: TObject);
  49.     procedure Button7Click(Sender: TObject);
  50.     procedure Button8Click(Sender: TObject);
  51.     procedure Button9Click(Sender: TObject);
  52.     procedure Button10Click(Sender: TObject);
  53.     procedure Timer1Timer(Sender: TObject);
  54.     procedure Button11Click(Sender: TObject);
  55.     procedure Button12Click(Sender: TObject);
  56.     procedure Button13Click(Sender: TObject);
  57.     procedure Button14Click(Sender: TObject);
  58.     procedure Button15Click(Sender: TObject);
  59.     procedure Button16Click(Sender: TObject);
  60.     procedure Button18Click(Sender: TObject);
  61.     procedure Button19Click(Sender: TObject);
  62.     procedure Button20Click(Sender: TObject);
  63.     procedure Button21Click(Sender: TObject);
  64.     procedure Button17Click(Sender: TObject);
  65.     procedure Button22Click(Sender: TObject);
  66.     procedure Button23Click(Sender: TObject);
  67.     procedure Button24Click(Sender: TObject);
  68.     procedure Button25Click(Sender: TObject);
  69.   private
  70.     { Private declarations }
  71.   public
  72.     { Public declarations }
  73.   end;
  74.  
  75.   TtvStringList = class(TStringList)
  76.   private
  77.   public
  78.   protected
  79.      procedure AppendToFile(const FileName : String);
  80.   end;
  81.  
  82. var
  83.   Form1: TForm1;
  84.  
  85. implementation
  86.  
  87. {$R *.DFM}
  88.  
  89. procedure TtvStringList.AppendToFile(const FileName : String);
  90. var
  91.    FFile : TextFile;
  92.    iString   : Integer;
  93. begin
  94.    // if the file doesn't exist then call some code that's already written
  95.    if not FileExists(FileName) then
  96.       SaveToFile(FileName)
  97.    else
  98.    // else we've got to open the file go to the end of it and loop through our list
  99.    begin
  100.       // associate the name of an external file with a file variable.
  101.       AssignFile( FFile, FileName );
  102.       // Prepare the file for having text added the end
  103.       System.Append( FFile );
  104.  
  105.       // loop through the list and write out the strings
  106.       for iString := 0 to Count - 1 do
  107.          Writeln( FFile, Strings[ iString ] );
  108.  
  109.       // Close the file
  110.       CloseFile( FFile );
  111.    end;
  112. end;
  113.  
  114. procedure TForm1.Button1Click(Sender: TObject);
  115. begin
  116.    ShowMessage( 'File Comments: ' + APIThing.GetFileInformation( Application.ExeName, 'Comments' ) );
  117. end;
  118.  
  119. procedure TForm1.FormCreate(Sender: TObject);
  120. begin
  121.    //Image1.Picture.Icon.Handle := ExtractIcon( 'C:\WINNT\Notepad.exe' );
  122.    Image1.Picture.Icon.Handle := APIThing.ExtractAssociatedIcon( Application.ExeName );
  123. end;
  124.  
  125. procedure TForm1.Button2Click(Sender: TObject);
  126. var
  127.    f1, f2 : string;
  128.    x : TFixedFileInfo;
  129. begin
  130.    f1 := 'C:\autoexec.bat';
  131.    f2 := 'C:\boot.ini';
  132.     case APIThing.CompareFileTime( f1, f2, ftLastWriteTime ) of
  133.        ftError             : ShowMessage( 'Error' );
  134.        ftFileOneIsOlder    : ShowMessage( f1 + '''s Last Write Time is older' );
  135.        ftFileTimesAreEqual : ShowMessage( f1 + ' and ' + f2 + ' have equal Last Write Time''s' );
  136.        ftFileTwoIsOlder    : ShowMessage( f2 + '''s Last Write Time is older' );
  137.     end; // case
  138.  
  139.     x := APIThing.FileInfo( Application.ExeName );
  140.     ShowMessage( 'Version: ' + IntToStr( x.wFileVersionLS ) + '.' + IntToStr( x.wFileVersionMS ) +
  141.                  #13#10'Release: ' + IntToStr( x.wProductVersionLS) +
  142.                  #13#10'Build: '  + IntToStr( x.wProductVersionMS ) );
  143. end;
  144.  
  145. procedure TForm1.Button3Click(Sender: TObject);
  146. var
  147.    i : integer;
  148.    s : String;
  149. begin
  150.    s := '';
  151.  
  152.    for i := 1 to Length( APIThing.LogicalDrives ) do
  153.       s := s + APIThing.LogicalDrives[i] + ':\ - ' +
  154.            IntToStr( APIThing.GetFreeDiskSpace( APIThing.LogicalDrives[i] ) ) + #13#10;
  155.  
  156.    ShowMessage( 'Free Disk Space:'#13#10 + s );
  157. end;
  158.  
  159. procedure TForm1.Button4Click(Sender: TObject);
  160. begin
  161.    ShowMessage( 'Current Directory: ' + APIThing.CurrentDirectory );
  162. end;
  163.  
  164. procedure TForm1.Button5Click(Sender: TObject);
  165. begin
  166.    ShowMessage( 'FileSize of ' + Application.ExeName + ': ' + IntToStr( APIThing.FileSize( Application.ExeName ) ) );
  167. end;
  168.  
  169. procedure TForm1.Button6Click(Sender: TObject);
  170. begin
  171.    ShowMessage( 'Short Path Name: ' + APIThing.GetShortPathName( Application.ExeName ) );
  172. end;
  173.  
  174. procedure TForm1.Button7Click(Sender: TObject);
  175. begin
  176.    ShowMessage( 'Temp Path: ' + APIThing.TempPath );
  177. end;
  178.  
  179. procedure TForm1.Button8Click(Sender: TObject);
  180. var
  181.    VolumeInfo : TVolumeInfo;
  182.    flags      : String;
  183. begin
  184.    VolumeInfo := APIThing.GetVolumeInformation( 'C' );
  185.    with VolumeInfo do
  186.    begin
  187.       if (FileSystemFlags and FS_CASE_IS_PRESERVED) <> 0 then
  188.             if Length( flags ) <> 0 then
  189.                flags := flags + #13#10#9'FS_CASE_IS_PRESERVED'
  190.             else
  191.                flags := 'FS_CASE_IS_PRESERVED';
  192.  
  193.          if (FileSystemFlags and FS_CASE_SENSITIVE) <> 0 then
  194.             if Length( flags ) <> 0 then
  195.                flags := flags + #13#10#9'FS_CASE_SENSITIVE'
  196.             else
  197.                flags := 'FS_CASE_SENSITIVE';
  198.  
  199.          if (FileSystemFlags and FS_UNICODE_STORED_ON_DISK) <> 0 then
  200.             if Length( flags ) <> 0 then
  201.                flags := flags + #13#10#9'FS_UNICODE_STORED_ON_DISK'
  202.             else
  203.                flags := 'FS_UNICODE_STORED_ON_DISK';
  204.  
  205.          if (FileSystemFlags and FS_PERSISTENT_ACLS) <> 0 then
  206.             if Length( flags ) <> 0 then
  207.                flags := flags + #13#10#9'FS_PERSISTENT_ACLS'
  208.             else
  209.                flags := 'FS_PERSISTENT_ACLS';
  210.  
  211.          if (FileSystemFlags and FS_FILE_COMPRESSION) <> 0 then
  212.             if Length( flags ) <> 0 then
  213.                flags := flags + #13#10#9'FS_FILE_COMPRESSION'
  214.             else
  215.                flags := 'FS_FILE_COMPRESSION';
  216.  
  217.          if (FileSystemFlags and FS_VOL_IS_COMPRESSED) <> 0 then
  218.             if Length( flags ) <> 0 then
  219.                flags := flags + #13#10#9'FS_VOL_IS_COMPRESSED'
  220.             else
  221.                flags := 'FS_VOL_IS_COMPRESSED';
  222.  
  223.       ShowMessage( 'Volume Information For Drive C'#13#10#13#10 +
  224.                    'Name:'#9 + Name + #13#10 +
  225.                    'Serial Number:'#9 + IntToStr( SerialNumber ) + #13#10 +
  226.                    'Max Component Length:'#9 + IntToStr( MaxComponentLength ) + #13#10 +
  227.                    'File System Flags:'#13#10#9 + Flags + #13#10 +
  228.                    'File System:'#9 + FileSystemName );
  229.    end; // with VolumeInfo
  230. end;
  231.  
  232. procedure TForm1.Button9Click(Sender: TObject);
  233. begin
  234.    ShowMessage( 'Full Path Name: ' + APIThing.GetFullPathName( Application.ExeName ) );
  235. end;
  236.  
  237. procedure TForm1.Button10Click(Sender: TObject);
  238. begin
  239.    ShowMessage( 'Logical Drives: ' + APIThing.LogicalDrives );
  240. end;
  241.  
  242. procedure TForm1.Timer1Timer(Sender: TObject);
  243. begin
  244.    Label1.Caption := 'System Time: ' + APIThing.SystemTime + #13#10'Local Time: ' + APIThing.LocalTime;
  245. end;
  246.  
  247. procedure TForm1.Button11Click(Sender: TObject);
  248. begin
  249.    ShowMessage( 'Windows Directory: ' + APIThing.WindowsDirectory );
  250. end;
  251.  
  252. procedure TForm1.Button12Click(Sender: TObject);
  253. begin
  254.     ShowMessage( 'System Directory: ' + APIThing.SystemDirectory );
  255. end;
  256.  
  257. procedure TForm1.Button13Click(Sender: TObject);
  258. var
  259.    s : String;
  260. begin
  261.    s := Application.ExeName;
  262.    with APIThing do
  263.       ShowMessage( 'GetFileTime Values For'#13#10 + s + #13#10#13#10 +
  264.                    'Creation Time: ' + DateTimeToStr( GetFileTime( s, ftCreationTime ) ) + #13#10 +
  265.                    'Last Access Time: ' + DateTimeToStr( GetFileTime( s, ftLastAccessTime ) ) + #13#10 +
  266.                    'Last Write Time: ' + DateTimeToStr( GetFileTime( s, ftLastWriteTime ) ) );
  267. end;
  268.  
  269. procedure TForm1.Button14Click(Sender: TObject);
  270. begin
  271.    ShowMessage( 'User Name: ' + APIThing.UserName );
  272. end;
  273.  
  274. procedure TForm1.Button15Click(Sender: TObject);
  275. begin
  276.    ShowMessage( 'Computer Name: ' + APIThing.ComputerName );
  277. end;
  278.  
  279. procedure TForm1.Button16Click(Sender: TObject);
  280. begin
  281.    ShowMessage('Executable for C:\boot.ini is:'#13#10 + APIThing.FindExecutable('C:\boot.ini'));
  282. end;
  283.  
  284. procedure TForm1.Button18Click(Sender: TObject);
  285. begin
  286.    ShowMessage( APIThing.ProcessorType );
  287. end;
  288.  
  289. procedure TForm1.Button19Click(Sender: TObject);
  290. begin
  291.    ShowMessage( IntToStr( APIThing.PageSize ) );
  292. end;
  293.  
  294. procedure TForm1.Button20Click(Sender: TObject);
  295. begin
  296.    ShowMessage( 'This machine has ' + IntToStr( APIThing.NumberOfProcessors ) + ' processor(s)' );
  297. end;
  298.  
  299. procedure TForm1.Button21Click(Sender: TObject);
  300. begin
  301.    ShowMessage( APIThing.OSVersion );
  302. end;
  303.  
  304. procedure TForm1.Button17Click(Sender: TObject);
  305. var
  306.    s1, s2 : String;
  307.    x      : TFixedFileInfo;
  308. begin
  309.    x := APIThing.FileInfo( Application.ExeName );
  310.    s1 := APIThing.GetFileInformation( Application.ExeName, 'InternalName' );
  311.    s2 := 'Version: ' + IntToStr( x.wFileVersionLS ) + '.' + IntToStr( x.wFileVersionMS ) +
  312.          ' (Build: '  + IntToStr( x.wProductVersionMS ) + ')'#13#10'Release: ' +
  313.          IntToStr( x.wProductVersionLS);
  314.  
  315.    APIThing.ShellAbout( s1, s2 );
  316. end;
  317.  
  318. procedure TForm1.Button22Click(Sender: TObject);
  319. begin
  320.    APIThing.FormatDrive( 'a' );
  321. end;
  322.  
  323. procedure TForm1.Button23Click(Sender: TObject);
  324. begin
  325.    with APIThing do
  326.    begin
  327.       ShowMessage( 'Memory Availability'#13#10 +
  328.                    'Memory Utilization: ' + IntToStr( dwMemoryLoad )+ '%'#13#10 +
  329.                    'Total bytes of physical memory: ' + IntToStr( dwTotalPhys ) + #13#10 +
  330.                    'Physical memory available: ' + IntToStr( dwAvailPhys ) + #13#10 +
  331.                    'Total number of bytes that can be stored in the paging file: ' + IntToStr( dwTotalPageFile ) + #13#10 +
  332.                    'Bytes available in the paging file: ' + IntToStr( dwAvailPageFile ) + #13#10 +
  333.                    'Total number of bytes that can be described in the user mode portion of the virtual address space of the calling process: ' + IntToStr( dwTotalVirtual ) + #13#10 +
  334.                    'Bytes of unreserved and uncommitted memory in the user mode portion of the virtual address space of the calling process: ' + IntToStr( dwAvailVirtual )
  335.                  );
  336.    end; // with APIThing
  337. end;
  338.  
  339.  
  340. procedure TForm1.Button24Click(Sender: TObject);
  341. var
  342.    dtDriveType  : TDriveType;
  343.    strDriveType : String;
  344.    drive        : Char;
  345. begin
  346.    drive := 'a';
  347.    dtDriveType := APIThing.DriveType( drive );
  348.    case dtDriveType of
  349.       dtUnknown : strDriveType := 'Unknown';
  350.       dtNoDrive : strDriveType := 'Not A Drive';
  351.       dtFloppy  : strDriveType := 'FDD';
  352.       dtFixed   : strDriveType := 'HDD';
  353.       dtNetwork : strDriveType := 'Network Drive';
  354.       dtCDROM   : strDriveType := 'CD-ROM';
  355.       dtRAM     : strDriveType := 'RAM Drive';
  356.    end; // case APIThing.DriveType;
  357.    ShowMessage( 'Drive ' + drive +' is a ''' + strDriveType + ''' drive' );
  358. end;
  359.  
  360.  
  361. procedure TForm1.Button25Click(Sender: TObject);
  362. begin
  363.    APIThing.ShutDown;
  364. end;
  365.  
  366. end.
  367.