dcutils.pas

DiskControls.v3.8.Full.Source 控制磁盘的控件 包括源代码

function OpenWithDlg(const FileName: String): Boolean; // returns True if succeed
begin
  try
    Result := WinExec(PChar('rundll32 shell32,OpenAs_RunDLL ' + FileName), SW_SHOWNORMAL) > 31;
  except
    Result := False;
  end;
end;

procedure RepaintScreen;
begin
  try
    WinExec('rundll32 user,repaintscreen', SW_SHOWNORMAL);
  except
  end;
end;


{ Numerical Conversion routines}
{ converts the 32bit Integer to unisgned Extended (float) type }
function IntToExt(Int: DWord): Extended;
var
  Hi, Lo: DWord;
begin
  Result := Int;
  if Int > 0 then Exit;
  Hi := Int shr 16;
  Lo := Int shl 16;
  Lo := Lo shr 16;
  Result := Hi;
  Result := Result * $10000; // shl 16
  Result := Result + Lo;
end;

{ converts the two 32bit Integer to unisgned Extended (float) type }
function Int2x32ToExt(IntHi, IntLo: DWord): Extended;
begin
  Result := IntToExt(IntHi);
  Result := Result * $10000; // shl 16
  Result := Result * $10000; // shl 16
  Result := Result + IntToExt(IntLo);
end;

{$IFDEF D4}
function Int2x32ToInt64(IntHi, IntLo: DWord): Int64;
var
  dw: Array[1..2] of DWord absolute Result;
begin
  dw[1] := IntLo;
  dw[2] := IntHi;
end;
{$ENDIF}

function UTCFileTimeToDateTime(Time: TFileTime): TDateTime;
var
  LocalFileTime: TFileTime;
  DOSFileTime: Integer;
begin
  try
    FileTimeToLocalFileTime(Time, LocalFileTime);
    if FileTimeToDosDateTime(LocalFileTime, LongRec(DOSFileTime).Hi, LongRec(DOSFileTime).Lo) then
     if DOSFileTime <> 0 then
      begin
       Result := FileDateToDateTime(DOSFileTime);
       Exit;
      end;
    Result := -1;
  except
    Result := -1;
  end;
end;

function DateTimeToUTCFileTime(Time: TDateTime): TFileTime;
var
  DOSFileTime: Integer;
begin
  try
    DOSFileTime := DateTimeToFileDate(Time);
    DOSDateTimeToFileTime(LongRec(DOSFileTime).Hi, LongRec(DOSFileTime).Lo, Result);
  except
  end;  
end;

{ converts datetime value without exception }
function StrToDateTimeDef(const S: String; DefDateTime: TDateTime): TDateTime;
type
  TDateOrder = (doMDY, doDMY, doYMD);
var
  Pos: Integer;
  Date, Time: TDateTime;
{$IFDEF VER100} // Delphi 3 only
  EraNames: Array[1..7] of String;
  EraYearOffsets: Array[1..7] of Integer;
{$ENDIF}

  procedure ScanBlanks(const S: String; var Pos: Integer);
  var
    I: Integer;
  begin
    I := Pos;
    while (I <= Length(S)) and (S[I] = ' ') do Inc(I);
    Pos := I;
  end;

  function ScanChar(const S: String; var Pos: Integer; Ch: Char): Boolean;
  begin
    Result := False;
    ScanBlanks(S, Pos);
    if (Pos <= Length(S)) and (S[Pos] = Ch) then
     begin
      Inc(Pos);
      Result := True;
     end;
  end;

  function ScanString(const S: String; var Pos: Integer;
    const Symbol: String): Boolean;
  begin
    Result := False;
    if Symbol <> '' then
     begin
      ScanBlanks(S, Pos);
      if AnsiCompareText(Symbol, Copy(S, Pos, Length(Symbol))) = 0 then
       begin
        Inc(Pos, Length(Symbol));
        Result := True;
       end;
     end;
  end;

  function ScanNumber(const S: String; var Pos: Integer;
    var Number: Word; var CharCount: Byte): Boolean;
  var
    I: Integer;
    N: Word;
  begin
    Result := False;
    CharCount := 0;
    ScanBlanks(S, Pos);
    I := Pos;
    N := 0;
    while (I <= Length(S)) and (S[I] in ['0'..'9']) and (N < 1000) do
     begin
      N := N * 10 + (Ord(S[I]) - Ord('0'));
      Inc(I);
     end;
    if I > Pos then
     begin
      CharCount := I - Pos;
      Pos := I;
      Number := N;
      Result := True;
     end;
  end;

  function IsValidDate(const Y, M, D: Word): Boolean;
  begin
    Result := (Y >= 1) and (Y <= 9999) and (M >= 1) and (M <= 12) and
      (D >= 1) and (D <= MonthDays[IsLeapYear(Y),M]);
  end;

  function IsValidTime(const Hour, Min, Sec, MSec: Word): Boolean;
  begin
    Result := (Hour < 24) and (Min < 60) and (Sec < 60) and (MSec < 1000);
  end;

  function ScanDate(const S: String; var Pos: Integer;
    var Date: TDateTime): Boolean;
  var
    DateOrder: TDateOrder;
    N1, N2, N3, Y, M, D: Word;
    L1, L2, L3, YearLen: Byte;
    EraName: String;
    EraYearOffset: Integer;
    CenturyBase: Integer;

    function GetDateOrder(const DateFormat: String): TDateOrder;
    var
      I: Integer;
    begin
      Result := doMDY;
      I := 1;
      while I <= Length(DateFormat) do
       begin
        case Chr(Ord(DateFormat[I]) and $DF) of
          'E': Result := doYMD;
          'Y': Result := doYMD;
          'M': Result := doMDY;
          'D': Result := doDMY;
          else
           Inc(I);
           Continue;
         end;
        Exit;
       end;
      Result := doMDY;
    end;

    function CurrentYear: Word;
    var
      SystemTime: TSystemTime;
    begin
      GetLocalTime(SystemTime);
      Result := SystemTime.wYear;
    end;

    function EraToYear(Year: Integer): Integer;
    begin
      {$IFDEF D3}
      if SysLocale.PriLangID = LANG_KOREAN then
       begin
        if Year <= 99 then
          Inc(Year, (CurrentYear + Abs(EraYearOffset)) div 100 * 100);
        if EraYearOffset > 0 then
          EraYearOffset := -EraYearOffset;
       end
      else
      {$ENDIF}
        Dec(EraYearOffset);
      Result := Year + EraYearOffset;
    end;

    function GetEraYearOffset(const Name: String): Integer;
    {$IFDEF D3}
    var
      I: Integer;
    {$ENDIF}  
    begin
      Result := 0;
      {$IFDEF D3}
      for I := Low(EraNames) to High(EraNames) do
       begin
        if EraNames[I] = '' then Break;
        if AnsiStrPos(PChar(EraNames[I]), PChar(Name)) <> nil then
         begin
          Result := EraYearOffsets[I];
          Exit;
         end;
       end;
      {$ENDIF}
    end;

    procedure ScanToNumber(const S: String; var Pos: Integer);
    begin
      while (Pos <= Length(S)) and not (S[Pos] in ['0'..'9']) do
       begin
        if S[Pos] in LeadBytes then Inc(Pos);
        Inc(Pos);
       end;
    end;

  begin
    Y := 0;
    M := 0;
    D := 0;
    YearLen := 0;
    Result := False;
    DateOrder := GetDateOrder(ShortDateFormat);
    EraYearOffset := 0;
    if ShortDateFormat[1] = 'g' then  // skip over prefix text
     begin
      ScanToNumber(S, Pos);
      EraName := Trim(Copy(S, 1, Pos-1));
      EraYearOffset := GetEraYearOffset(EraName);
     end
    else
     {$IFDEF D3}
     if AnsiPos('e', ShortDateFormat) > 0 then
       EraYearOffset := EraYearOffsets[1];
     {$ELSE}
      EraYearOffset := 0;
     {$ENDIF}
    if not (ScanNumber(S, Pos, N1, L1) and ScanChar(S, Pos, DateSeparator) and
      ScanNumber(S, Pos, N2, L2)) then Exit;
    if ScanChar(S, Pos, DateSeparator) then
     begin
      if not ScanNumber(S, Pos, N3, L3) then Exit;
      case DateOrder of
        doMDY: begin
                Y := N3;
                YearLen := L3;
                M := N1;
                D := N2;
               end;
        doDMY: begin
                Y := N3;
                YearLen := L3;
                M := N2;
                D := N1;
               end;
        doYMD: begin
                Y := N1;
                YearLen := L1;
                M := N2;
                D := N3;
               end;
       end;
      if EraYearOffset > 0 then
        Y := EraToYear(Y)
      else
       if YearLen <= 2 then
        begin
         CenturyBase := CurrentYear - TwoDigitYearCenturyWindow;
         Inc(Y, CenturyBase div 100 * 100);
         if (TwoDigitYearCenturyWindow > 0) and (Y < CenturyBase) then
           Inc(Y, 100);
        end;
     end
    else
     begin
      Y := CurrentYear;
      if DateOrder = doDMY then
       begin
        D := N1;
        M := N2;
       end
      else
       begin
        M := N1;
        D := N2;
       end;
     end;
    ScanChar(S, Pos, DateSeparator);
    ScanBlanks(S, Pos);
    {$IFDEF D3}
    if SysLocale.FarEast and (System.Pos('ddd', ShortDateFormat) <> 0) then
     begin     // ignore trailing text
      if ShortTimeFormat[1] in ['0'..'9'] then  // stop at time digit
        ScanToNumber(S, Pos)
      else  // stop at time prefix
       repeat
         while (Pos <= Length(S)) and (S[Pos] <> ' ') do Inc(Pos);
         ScanBlanks(S, Pos);
       until (Pos > Length(S)) or
             (AnsiCompareText(TimeAMString, Copy(S, Pos, Length(TimeAMString))) = 0) or
             (AnsiCompareText(TimePMString, Copy(S, Pos, Length(TimePMString))) = 0);
     end;
    {$ENDIF} 

    Result := IsValidDate(Y, M, D);
    if Result then Date := EncodeDate(Y, M, D);
  end;

  function ScanTime(const S: String; var Pos: Integer;
    var Time: TDateTime): Boolean;
  var
    BaseHour: Integer;
    Hour, Min, Sec: Word;
    Junk: Byte;
  begin
    Result := False;
    BaseHour := -1;
    if ScanString(S, Pos, TimeAMString) or ScanString(S, Pos, 'AM') then
      BaseHour := 0
    else if ScanString(S, Pos, TimePMString) or ScanString(S, Pos, 'PM') then
      BaseHour := 12;
    if BaseHour >= 0 then ScanBlanks(S, Pos);
    if not ScanNumber(S, Pos, Hour, Junk) then Exit;
    Min := 0;
    if ScanChar(S, Pos, TimeSeparator) then
      if not ScanNumber(S, Pos, Min, Junk) then Exit;
    Sec := 0;
    if ScanChar(S, Pos, TimeSeparator) then
      if not ScanNumber(S, Pos, Sec, Junk) then Exit;
    if BaseHour < 0 then
      if ScanString(S, Pos, TimeAMString) or ScanString(S, Pos, 'AM') then
        BaseHour := 0
      else
        if ScanString(S, Pos, TimePMString) or ScanString(S, Pos, 'PM') then
          BaseHour := 12;
    if BaseHour >= 0 then
     begin
      if (Hour = 0) or (Hour > 12) then Exit;
      if Hour = 12 then Hour := 0;
      Inc(Hour, BaseHour);
     end;
    ScanBlanks(S, Pos);

    Result := IsValidTime(Hour, Min, Sec, 0);
    if Result then Time := EncodeTime(Hour, Min, Sec, 0);
  end;

begin
  Pos := 1;
  Time := 0;
  if not ScanDate(S, Pos, Date) or not ((Pos > Length(S)) or
    ScanTime(S, Pos, Time)) then
   begin   // Try time only
    Pos := 1;
    if not ScanTime(S, Pos, Result) or (Pos <= Length(S)) then
      Result := DefDateTime;
   end
  else
   if Date >= 0 then Result := Date + Time
   else Result := Date - Time;
end;


{ miscellaneous routines }
function GetOS: TdcOSVersion;
var
  OS: TOSVersionInfo;
begin
  ZeroMemory(@OS,SizeOf(OS));
  OS.dwOSVersionInfoSize := SizeOf(OS);
  GetVersionEx(OS);
  Result := osUnknown;
  if OS.dwPlatformId = VER_PLATFORM_WIN32_NT then
   case OS.dwMajorVersion of
     3: Result := osNT3;
     4: Result := osNT4;
     5: Result := os2K;
    end
  else
   if (OS.dwMajorVersion = 4) and (OS.dwMinorVersion = 0) then
    begin
     Result := os95;
     if (Trim(OS.szCSDVersion) = 'B') then
       Result := os95OSR2;
    end
   else
    if (OS.dwMajorVersion = 4) and (OS.dwMinorVersion = 10) then
     begin
      Result := os98;
      if Trim(OS.szCSDVersion) = 'A' then
        Result := os98SE;
     end;
end;

function GetOSStr: String;
const
  TdcOSVersionStr: Array[0..8] of String = ('Unknown', 'Win95', 'Win95OSR2', 'Win98', 'Win98SE', 'WinNT3', 'WinNT4', 'Win2K', 'WinME');
begin
  Result := TdcOSVersionStr[Integer(GetOS)];
end;

{ True when the Windows 2000 or higher }
function IsNT: Boolean;
begin
  Result := GetOS in [osNT3, osNT4, os2K];  
end;

{ True if OS is Windows XP or higher }
function IsXP: Boolean;
var
  OS: TOSVersionInfo;
begin
  ZeroMemory(@OS,SizeOf(OS));
  OS.dwOSVersionInfoSize := SizeOf(OS);
  GetVersionEx(OS);
  Result := ((OS.dwMajorVersion = 5) and (OS.dwMinorVersion >= 1)) or
            (OS.dwMajorVersion > 5);
end;

{ returns path to System directory }
function GetSystemDir: String;
var
  PC: Array[0..MAX_PATH + 1] of Char;
begin
  GetSystemDirectory(PC, MAX_PATH);
  Result := IncludeTrailingBackslash(StrPas(PC));
end;

{ returns path to Windows directory }
function GetWindowsDir: String;
var
  PC: Array[0..MAX_PATH + 1] of Char;
begin
  GetWindowsDirectory(PC, MAX_PATH);
  Result := IncludeTrailingBackslash(StrPas(PC));
end;

{ returns path to Temporary directory }
function GetTempDir: String;
var
  PC: Array[0..MAX_PATH + 1] of Char;
begin
  GetTempPath(MAX_PATH, PC);
  Result := IncludeTrailingBackslash(StrPas(PC));
end;

{ Returns file version for EXE/DLLs }
function GetFileVersion(FileName: String): DWord;
var
  Handle: DWord;
  Data: Pointer;
  Size: Integer;
  FixedInfo: PVSFixedFileInfo;
begin
  Result := 0;
  FixedInfo := nil;
  Size := GetFileVersionInfoSize(PChar(FileName), Handle);
  if Size = 0 then Exit;
  GetMem(Data, Size);
  try
    if not GetFileVersionInfo(PChar(FileName), 0, Size, Data) then Exit;
    if not VerQueryValue(Data, '\', Pointer(FixedInfo), Handle) then Exit;
    with FixedInfo^ do
      Result := dwFileVersionMS or dwFileVersionMS;
  finally
    FreeMem(Data);
  end;
end;


{ graphics }
function IsPictureNotEmpty(const Picture: TPicture): Boolean;
begin
  with Picture do
   Result := Assigned(Graphic) and not Graphic.Empty;
//           and (Width > 0) and (Height > 0);
end;

function GetTextHeight(const Canvas: TCanvas): Integer;
begin
  Result := Canvas.TextHeight('Wj');
end;

end.