utilities32.pas

Motorola 集群通信系统中SDTS车载台PEI端测试程序

unit Utilities32;

interface
{$LONGSTRINGS ON}
uses
  Windows, LZExpand, SysUtils, Printers,
  ShlObj, ActiveX, ComObj, Registry, Classes;

function GetJPGSize(const sFile: string) : TPoint;
//procedure GetPNGSize(const sFile: string; var wWidth, wHeight: word);
//procedure GetGIFSize(const sGIFFile: string; var wWidth, wHeight: word);

procedure Delay_(ms : integer);
function AddBackSlash(const S: String): String;
function StripBackSlash(const S: String): String;
procedure CopyFile(Source, Dest: ShortString);
function StringAsPChar(var S: OpenString): PChar;
function GetGutterLeft : integer;
function GetGutterTop : integer;
function GetGutterRight : integer;
function GetGutterBottom : integer;
function GetPhysPageWidth : integer;
function GetPhysPageHeight : integer;
function Pixel2cmX(p : integer) : real;
function Pixel2cmY(p : integer) : real;
function cm2PixelX(cm : real) : integer;
function cm2PixelY(cm : real) : integer;
function SysDir: string;
function WinDir: string;
function GetTempEnvVar : string;
function DirExists(const S : String): Boolean;
procedure CreateDesktopLink(LinkName, Filename, Arguments : string);
function SizeOfFile(const FName: string): integer;
function GetLongName(sShortName : string; var bError : boolean) : string;
function GetShortName(sLongName : string) : string;
function IsAdmin: Boolean;  // return TRUE for Admins (or Win95/98/ME)

implementation

function ReadMWord(f: TFileStream): word;
 type
   TMotorolaWord = record
     case byte of
       0: (Value: word);
       1: (Byte1, Byte2: byte);
   end;
 var
   MW: TMotorolaWord;
 begin
   { It would probably be better to just read these two bytes in normally }
   { and then do a small ASM routine to swap them.  But we aren't talking }
   { about reading entire files, so I doubt the performance gain would be }
   { worth the trouble. }
   f.Read(MW.Byte2, SizeOf(Byte));
   f.Read(MW.Byte1, SizeOf(Byte));
   Result := MW.Value;
 end;

function GetJPGSize(const sFile: string) : TPoint;
const
  ValidSig : array[0..1] of byte = ($FF, $D8);
  Parameterless = [$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7];
var
  Sig: array[0..1] of byte;
  f: TFileStream;
  x: integer;
  Seg: byte;
  Dummy: array[0..15] of byte;
  Len: word;
  ReadLen: LongInt;
begin
  FillChar(Sig, SizeOf(Sig), #0);
  f := TFileStream.Create(sFile, fmOpenRead);
  try
    ReadLen := f.Read(Sig[0], SizeOf(Sig));
    for x := Low(Sig) to High(Sig) do
      if Sig[x] <> ValidSig[x] then
        ReadLen := 0;
    if ReadLen > 0 then begin
      ReadLen := f.Read(Seg, 1);
      while (Seg = $FF) and (ReadLen > 0) do begin
        ReadLen := f.Read(Seg, 1);
        if Seg <> $FF then begin
          if (Seg = $C0) or (Seg = $C1) then begin
            ReadLen := f.Read(Dummy[0], 3); { don't need these bytes }
            Result.y := ReadMWord(f);
            Result.x := ReadMWord(f);
          end
          else begin
            if not (Seg in Parameterless) then begin
              Len := ReadMWord(f);
              f.Seek(Len-2, 1);
              f.Read(Seg, 1);
            end
            else
              Seg := $FF; { Fake it to keep looping. }
          end;
        end;
      end;
    end;
  finally
    f.Free;
  end;
end;

function IsAdmin: Boolean;  // return TRUE for Admins (or Win95/98/ME)
const
  SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
  SECURITY_BUILTIN_DOMAIN_RID = $00000020;
  DOMAIN_ALIAS_RID_ADMINS     = $00000220;
var
  hAccessToken: THandle;
  ptgGroups: PTokenGroups;
  dwInfoBufferSize: DWORD;
  psidAdministrators: PSID;
  x: Integer;
  bSuccess: BOOL;
begin
  if Win32Platform <> VER_PLATFORM_WIN32_NT then
  begin
    Result := True;
    exit;
  end;

  Result := False;
  bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True,
    hAccessToken);
  if not bSuccess then
  begin
    if GetLastError = ERROR_NO_TOKEN then
    bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY,
      hAccessToken);
  end;
  if bSuccess then
  begin
    GetMem(ptgGroups, 1024);
    bSuccess := GetTokenInformation(hAccessToken, TokenGroups,
      ptgGroups, 1024, dwInfoBufferSize);
    CloseHandle(hAccessToken);
    if bSuccess then
    begin
      AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
        SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS,
        0, 0, 0, 0, 0, 0, psidAdministrators);
      {$R-}
      for x := 0 to ptgGroups.GroupCount - 1 do
        if EqualSid(psidAdministrators, ptgGroups.Groups[x].Sid) then
        begin
          Result := True;
          Break;
        end;
      {$R+}
      FreeSid(psidAdministrators);
    end;
    FreeMem(ptgGroups);
  end;
end;

function GetShortName(sLongName : string) : string;
var
  sShortName    : string;
  nShortNameLen : integer;
begin
  SetLength(sShortName, MAX_PATH);
  nShortNameLen := GetShortPathName(PChar(sLongName), PChar(sShortName), MAX_PATH-1);
  if nShortNameLen = 0 then begin
   { handle errors... }
  end;
  SetLength(sShortName, nShortNameLen);
  Result := sShortName;
end;

function GetLongName(sShortName : string; var bError : boolean) : string;
var
  bAddSlash : boolean;
  SearchRec : TSearchRec;
  nStrLen   : integer;
begin
  bError    := False;
  Result    := sShortName;
  nStrLen   := Length(sShortName);
  bAddSlash := False;

  if sShortName[nStrLen] = '\' then begin
    bAddSlash := True;
    SetLength(sShortName, nStrLen-1);
    dec(nStrLen);
  end;

  if((nStrLen-Length(ExtractFileDrive(sShortName))) > 0) then begin
    if FindFirst(sShortName, faAnyFile, SearchRec) = 0 then begin
      Result := ExtractFilePath(sShortName) + SearchRec.name;
      if bAddSlash then begin
        Result := Result + '\';
      end;
    end
    else
    begin
     // handle errors...       bError := True;
    end;
    FindClose(SearchRec);
  end;
end;

function SizeOfFile(const FName: string): integer;
var
  F: TSearchRec;
  Found: integer;
begin
  Result := 0;
  Found := FindFirst(FName,faAnyFile,F);
  if Found = 0 then Result := F.Size;
  SysUtils.FindClose(F);
end;


procedure CreateDesktopLink(LinkName, Filename, Arguments : string);
var
  MyObject  : IUnknown;
  MySLink   : IShellLink;
  MyPFile   : IPersistFile;
  Directory : String;
  WFileName : WideString;
  MyReg     : TRegIniFile;
begin

  MyObject := CreateComObject(CLSID_ShellLink);
  MySLink := MyObject as IShellLink;
  MyPFile := MyObject as IPersistFile;
  with MySLink do begin
    SetArguments(PChar(Arguments));
    SetPath(PChar(FileName));
    SetWorkingDirectory(PChar(ExtractFilePath(FileName)));
  end;
  MyReg := TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\Explorer');
// Use the next line of code to put the shortcut on your desktop
  Directory := MyReg.ReadString('Shell Folders','Desktop','');
  WFileName := Directory+'\'+LinkName+'.lnk';
  MyPFile.Save(PWChar(WFileName),False);
// Use the next three lines to put the shortcut on your start menu
//  Directory := MyReg.ReadString('Shell Folders','Start Menu','')+
//      '\Whoa!';
//  CreateDir(Directory);
  MyReg.Free;
end;



function DirExists(const S : String): Boolean;
var
  OldMode : Word;
  OldDir  : String;
begin
  Result := True;
  GetDir(0, OldDir); {save old dir for return}
  OldMode := SetErrorMode(SEM_FAILCRITICALERRORS); {if drive empty, except}
  try
    try
      {$I-}
      ChDir(S);
      {$I+}
      Result := IOResult = 0;
    except
      ON EInOutError DO
        Result := False;
    end;
  finally
    ChDir(OldDir); {return to old dir}
    SetErrorMode(OldMode); {restore old error mode}
  end;
end;

function GetTempEnvVar: string;
var
  EnvStr: Array[0..255] of char;
begin
  GetEnvironmentVariable('TEMP',EnvStr,255);
  Result := StrPas(EnvStr);
  Result := AddBackSlash(Result);
end;

function SysDir: string;
var
  SystemDir: Array[0..255] of char;
Begin
  GetSystemDirectory(@SystemDir, 255);
  Result := StrPas(SystemDir);
  Result := AddBackSlash(Result);
end;

function WinDir: string;
var
  WindowsDir: Array[0..255] of char;
Begin
  GetWindowsDirectory(@WindowsDir, 255);
  Result := StrPas(WindowsDir);
  Result := AddBackSlash(Result);
end;

function Pixel2cmX(p : integer) : real;
begin
  Result := p / GetDeviceCaps(Printer.Handle, LOGPIXELSX);
  Result := Result * 2.54;
end;

function Pixel2cmY(p : integer) : real;
begin
  Result := p / GetDeviceCaps(Printer.Handle, LOGPIXELSY);
  Result := Result * 2.54;
end;

function cm2PixelX(cm : real) : integer;
begin
  Result := Round((cm / 2.54) * GetDeviceCaps(Printer.Handle, LOGPIXELSX));
end;

function cm2PixelY(cm : real) : integer;
begin
  Result := Round((cm / 2.54) * GetDeviceCaps(Printer.Handle, LOGPIXELSY));
end;

function GetGutterLeft : integer;
var
  pt : TPoint;
begin
  Escape(Printer.Handle,GETPRINTINGOFFSET,0,NIL,@pt);
  Result := pt.X;
end;

function GetGutterTop : integer;
var
  pt : TPoint;
begin
  Escape(Printer.Handle,GETPRINTINGOFFSET,0,NIL,@pt);
  Result := pt.Y;
end;

function GetGutterRight : integer;
begin
  Result := GetPhysPageWidth - Printer.PageWidth - GetGutterLeft;
end;

function GetGutterBottom : integer;
begin
  Result := GetPhysPageHeight - Printer.PageHeight - GetGutterTop;
end;

function GetPhysPageWidth : integer;
var
  pt : TPoint;
begin
  Escape(Printer.Handle,GETPHYSPAGESIZE,0,NIL,@pt);
  Result := pt.X;
end;

function GetPhysPageHeight : integer;
var
  pt : TPoint;
begin
  Escape(Printer.Handle,GETPHYSPAGESIZE,0,NIL,@pt);
  Result := pt.Y;
end;

function StringAsPChar(var S: ShortString): PChar;
{ This function null-terminates a string so that it can be passed to functions }
{ that require PChar types. If string is longer than 254 chars, then it will   }
{ be truncated to 254. }
begin
  if Length(S) = High(S) then Dec(S[0]); { Truncate S if it's too long }
  S[Ord(Length(S)) + 1] := #0;           { Place null at end of string }
  Result := @S[1];                       { Return "PChar'd" string }
end;

procedure CopyFile(Source, Dest: ShortString);
var
  SourceHand, DestHand: Integer;
  OpenBuf: TOFStruct;
begin
  { Open source file, and pass our psuedo-PChar as the filename }
  SourceHand := LZOpenFile(StringAsPChar(Source), OpenBuf, of_Share_Deny_Write or of_Read);
  { raise an exception on error }
  if SourceHand = -1 then
    raise EInOutError.Create('Error opening source file "' + Source + '"');
  try
    { Open destination file, and pass our psuedo-PChar as the filename }
    DestHand := LZOpenFile(StringAsPChar(Dest), OpenBuf, of_Share_Exclusive or of_Write
                           or of_Create);
    { Check for error and raise exception }
    if DestHand = -1 then
      raise EInOutError.CreateFmt('Error opening destination file "%s"',[Dest]);
    try
      { copy source to dest, raise exception on error }
      if LZCopy(SourceHand, DestHand) < 0 then
        raise EInOutError.CreateFmt('Error copying file "%s"', [Source]);
    finally
      { whether or not an exception occurs, we need to close the files }
      LZClose(DestHand);
    end;
  finally
    LZClose(SourceHand);
  end;
end;

function AddBackSlash(const S: String): String;
{ Adds a backslash to string S.  If S is already 255 chars or already has }
{ trailing backslash, then function returns S. }
begin
  if s = '' then begin
    Result := s;
    exit;
  end;
  if (Length(S) < 255) and (S[Length(S)] <> '\') then
    Result := S + '\'
  else
    Result := S;
end;

function StripBackSlash(const S: String): String;
{ Removes trailing backslash from S, if one exists }
begin
  Result := S;
  if Result[Length(Result)] = '\' then
    Delete(Result,Length(Result),1);
end;

procedure Delay_(ms : longint);
var
  t : longint;
begin
  if ms > 10000 then
    ms := 10000;
  t := GetTickCount;
  repeat
  until GetTickCount > t + ms;
end;

end.