BillsEditor/CU/ConstMethodUnit.pas

unit ConstMethodUnit;

interface

uses windows, Forms, Variants, ConstVarUnit, Classes, Math;

// 判断当前系统是否是64位 GiLi
function IsWin64: Boolean;
// 警告
function MessageWarning(AHandle: THandle; AText: string;
    ACaption: string = '警告'; AButtons: Cardinal = MB_OK): Cardinal;
// 提示
function MessageHint(AHandle: THandle; AText: string;
    ACaption: string = '提示'; AButtons: Cardinal = MB_OK): Cardinal;
// 询问
function MessageQuest(AHandle: THandle; AText: string;
    ACaption: string = '询问'; AButtons: Cardinal = MB_OKCANCEL): Cardinal; overload;
function MessageQuest(AText: string; ACaption: string = '询问'): Boolean; overload;
// 错误
function MessageError(AHandle: THandle; AText: string;
    ACaption: string = '错误'; AButtons: Cardinal = MB_OK): Cardinal;

function CheckFileExists(const FileName: string): Boolean;

function CheckSpecialChar(const aText: string): Boolean;

function CheckFileEnabled(const AFullFileName: string): Boolean;

function ScRoundTo(const AValue: Double; const ADigit: Integer = -2): Double;

function GetSaveFile: string;
function OpenFileDialog(const aTitle, aDefaultExt, aFileName, aFilter: string; var aNewFileName: string): Boolean;
function SaveFileDialog(const aTitle, aDefaultExt, aFileName, aFilter: string; var aNewFileName: string): Boolean;

function ProcessIsRunning(const aProcessName: string): Integer;
// 获得本机Mac地址
function MacAddress: string;

function LoadServiceQQ: string;

// 输入对话框（返回输入结果）
function ScInputBox(const ACaption, APrompt, ADefault: string): string;
// 输入对话框（返回是否确认）
function ScInputQuery(const ACaption, APrompt: string;
    var Value: string; ANeedMark: Boolean = False): Boolean;

// 输入密码
function InputPassWord(var APwd: string): Boolean;
// 修改或设置密码
function SetupPassWord(var APwd: string): Boolean;

function GetLocalGUID: TGUID;

function IsLocalGUID(AGUID: TGUID): Boolean;

{get parent code}
function GetPreCode(const ACode: string): string;

function FixPathByAppPath(const AFileName: string): string;

function ExtractFileNameWithoutExt(const AFileName: string): string;

function ScVarToCurrency(const V: Variant): Currency;

function ScVarToFloat(const V: Variant): Double;

function ScVarToFloatDef(const V: Variant; Def: Double): Double;
{set progress}
procedure IncProgressUI(const Step: Integer);
{display stdbillslib}
procedure DisplayStdBillsLib;
{get a random string, 10}
function GetRandomName: string;

function ConvertUnitStr(aUnitStr: string): string;

//获取文件版本号
function GetFileVersion: string;

// 获得文件版本（转换成四个整数形式）
function ScDecodeFileVer(AVersion: string; var V1, V2, V3, V4: Integer): Boolean;
// 比较版本大小,大于0表示AVersion1新，等于0一样，小于0表示AVersion2新
function ScCompareFileVer(AVersion1: string; AVersion2: string; APartCount: Integer = 4): Integer;

{template method}
procedure ExcuteTemplateMethod(aMethod: Pointer; Owner: TObject = nil);

{Get locatebills strings}
function GetLocateBillsStrings: Integer;
{Auto Save Projects}
procedure AutoSaveProjects(const aAutoSave: Boolean; const aSaveInterval: Integer);

function CheckProjectOpened(ASelect: Integer; const AFileName: string): Integer;

function CompareCodes(ACode1, ABCode1, AName1, ACode2, ABCode2, AName2: string): Integer;
function CompareCode(const Code1, Code2: string): Integer;
function CompareCodeWithChar(const ACode1, ACode2: string; ADelimiter: Char = '-'): Integer;

// 清空内容为指针的List
procedure ClearPointerList(AList: TList);
procedure ClearObjectList(aList: TList);

// 获得临时文件路径
function GetTempFilePath: string;
// 获得临时文件名
function GetTempFileName(AExt: string = ''): string;

// 随机生成名称
function GetTempName(ALength: Integer = 8): string;

// 自动替换或添加后缀
procedure FixFileExt(var AFileName: string; const AExt: string; AutoReplace: Boolean = False);

// 创建全部层次路径
function CreateFullDir(ADir: string): Boolean;

function SystemDateTime: TDateTime;
function CompileDateTime: TDateTime;
function BillCategory(ACode, AB_Code: string): TBillCategory;
function FormatBCodeAlpha(AB_Code: string): String;

var
    NumStrToAlpha: Array[0..29] of TIdentMapEntry = (
    (Value: 10; Name: 'A'), (Value: 11; Name: 'B'), (Value: 12; Name: 'C'),
    (Value: 13; Name: 'D'), (Value: 14; Name: 'E'), (Value: 15; Name: 'F'),
    (Value: 16; Name: 'G'), (Value: 17; Name: 'H'), (Value: 18; Name: 'I'),
    (Value: 19; Name: 'J'),
    (Value: 20; Name: 'K'), (Value: 21; Name: 'L'), (Value: 22; Name: 'M'),
    (Value: 23; Name: 'N'), (Value: 24; Name: 'O'), (Value: 25; Name: 'P'),
    (Value: 26; Name: 'Q'), (Value: 27; Name: 'R'), (Value: 28; Name: 'S'),
    (Value: 29; Name: 'T'),
    (Value: 30; Name: 'U'), (Value: 31; Name: 'V'), (Value: 32; Name: 'W'),
    (Value: 33; Name: 'X'), (Value: 34; Name: 'Y'), (Value: 35; Name: 'Z'),
    (Value: 36; Name: 'ZA'), (Value: 37; Name: 'ZB'), (Value: 38; Name: 'ZC'),
    (Value: 39; Name: 'ZD')
    );

var
  _ServerDateTime: TDateTime = 0;

implementation

uses
  SysUtils, Dialogs, Controls, StdCtrls, Graphics,
  IniFiles, TLHelp32;

function IsWin64: Boolean;
var
  Kernel32Handle: THandle;
  IsWow64Process: function(Handle: Windows.THandle; var Res: Windows.BOOL): Windows.BOOL; stdcall;
  GetNativeSystemInfo: procedure(var lpSystemInfo: TSystemInfo); stdcall;
  isWoW64: Bool;
  SystemInfo: TSystemInfo;
const
  PROCESSOR_ARCHITECTURE_AMD64 = 9;
  PROCESSOR_ARCHITECTURE_IA64 = 6;   
begin
  Kernel32Handle := GetModuleHandle('KERNEL32.DLL');
  if Kernel32Handle = 0 then
    Kernel32Handle := LoadLibrary('KERNEL32.DLL');
  if Kernel32Handle <> 0 then
  begin  
    IsWOW64Process := GetProcAddress(Kernel32Handle,'IsWow64Process');
    GetNativeSystemInfo := GetProcAddress(Kernel32Handle,'GetNativeSystemInfo');
    if Assigned(IsWow64Process) then
    begin  
      IsWow64Process(GetCurrentProcess,isWoW64);
      Result := isWoW64 and Assigned(GetNativeSystemInfo);
      if Result then
      begin
        GetNativeSystemInfo(SystemInfo);
        Result := (SystemInfo.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_AMD64) or
                  (SystemInfo.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_IA64);
      end;
    end
    else Result := False;
  end
  else Result := False;
end;

function MessageWarning(AHandle: THandle; AText: string;
      ACaption: string = '警告'; AButtons: Cardinal = MB_OK): Cardinal;
var
  Hdl: THandle;
begin
  if AHandle = 0 then
//    Hdl := Application.Handle
  begin
    if (Screen.ActiveForm <> nil) and Screen.ActiveForm.HandleAllocated then
      Hdl := Screen.ActiveForm.Handle
    else
      Hdl := 0;
  end
  else
    Hdl := AHandle;
  Result := MessageBox(Hdl, PChar(AText), PChar(ACaption), AButtons or MB_ICONWARNING);
end;

function MessageHint(AHandle: THandle; AText: string;
      ACaption: string = '提示'; AButtons: Cardinal = MB_OK): Cardinal;
var
  Hdl: THandle;
begin
  if AHandle = 0 then
//    Hdl := Application.Handle
  begin
    if (Screen.ActiveForm <> nil) and Screen.ActiveForm.HandleAllocated then
      Hdl := Screen.ActiveForm.Handle
    else
      Hdl := 0;
  end
  else
    Hdl := AHandle;
  Result := MessageBox(Hdl, PChar(AText), PChar(ACaption), AButtons or MB_ICONINFORMATION);
end;

function MessageQuest(AHandle: THandle; AText: string;
      ACaption: string = '询问'; AButtons: Cardinal = MB_OKCANCEL): Cardinal;
var
  Hdl: THandle;
begin
  if AHandle = 0 then
//    Hdl := Application.Handle
  begin
    if (Screen.ActiveForm <> nil) and Screen.ActiveForm.HandleAllocated then
      Hdl := Screen.ActiveForm.Handle
    else
      Hdl := 0;
  end
  else
    Hdl := AHandle;
  Result := MessageBox(Hdl, PChar(AText), PChar(ACaption), AButtons or MB_ICONQUESTION);
end;

function MessageQuest(AText: string; ACaption: string = '询问'): Boolean;
var
  Hdl: THandle;
begin
  Hdl := Screen.ActiveForm.Handle;
  Result := MessageBox(Hdl, PChar(AText), PChar(ACaption),
    MB_OKCANCEL or MB_ICONQUESTION) = IDOK;
end;

function MessageError(AHandle: THandle; AText: string;
      ACaption: string = '错误'; AButtons: Cardinal = MB_OK): Cardinal;
var
  Hdl: THandle;
begin
  if AHandle = 0 then
//    Hdl := Application.Handle
  begin
    if (Screen.ActiveForm <> nil) and Screen.ActiveForm.HandleAllocated then
      Hdl := Screen.ActiveForm.Handle
    else
      Hdl := 0;
  end
  else
    Hdl := AHandle;
  Result := MessageBox(Hdl, PChar(AText), PChar(ACaption), AButtons or MB_ICONERROR);
end;

function CheckFileExists(const FileName: string): Boolean;
var
  strFilePath: string;
begin
  strFilePath := Format('%s\我的清单\%s.smb', [(ExtractFileDir(ParamStr(0))), FileName]);
  Result := FileExists(strFilePath);
  strFilePath := ExtractFileDir(strFilePath);
  if not Result and not DirectoryExists(strFilePath) then
  begin
    ForceDirectories(strFilePath);
  end;
end;

function CheckSpecialChar(const aText: string): Boolean;

const
  SpecialArray: array [0..8] of Char = ('/', '\', ':', '*', '?', '"', '<', '>', '|');

var
  I, J: Integer;
begin
  Result := False;
  for I := 1 to Length(aText) do
  begin
    for J := Low(SpecialArray) to High(SpecialArray) do
      if aText[I] = SpecialArray[J] then
      begin
        Result := True;
        Break;
      end;
  end;
end;

function ExtractFileNameWithoutExt(const AFileName: string): string;
var
  sFileName, Ext: string;
begin
  Result := '';
  if AFileName = '' then Exit;
  sFileName := AFileName;
  if sFileName[Length(sFileName)] = '\' then
    Delete(sFileName, Length(sFileName), 1);
  Result := ExtractFileName(sFileName);
  Ext := ExtractFileExt(sFileName);
  Delete(Result, Length(Result) - Length(Ext) + 1, Length(Ext));
end;

function ScVarToCurrency(const V: Variant): Currency;
begin
  if VarIsNull(V) then
    Result := 0.0
  else if VarToStr(V) = '' then
    Result := 0.0
  else
    Result := V;
end;

function ScVarToFloat(const V: Variant): Double;
begin
  if VarIsNull(V) then
    Result := 0.0
  else if VarToStr(V) = '' then
    Result := 0.0
  else
    Result := V;
end;

function ScVarToFloatDef(const V: Variant; Def: Double): Double;
begin
  if VarIsNull(V) then
    Result := Def
  else if VarToStr(V) = '' then
    Result := Def
  else
    Result := V;
end;

procedure IncProgressUI(const Step: Integer);
begin
  SendMessage(Application.MainForm.Handle, SM_ProgressInc, Step, 0);
end;

procedure DisplayStdBillsLib;
begin
  SendMessage(Application.MainForm.Handle, SM_StdBillsLib, 0, 0);
end;

function GetRandomName: string;
var
  I: Integer;
  arrStr: array [0..35] of Char;
begin
  arrStr[1]:='0'; arrStr[2]:='1'; arrStr[3]:='2'; arrStr[4]:='3';
  arrStr[5]:='4'; arrStr[6]:='5'; arrStr[7]:='6'; arrStr[8]:='7';
  arrStr[9]:='8'; arrStr[10]:='9'; arrStr[11]:='A'; arrStr[12]:='B';
  arrStr[13]:='C'; arrStr[14]:='D'; arrStr[15]:='E'; arrStr[16]:='F';
  arrStr[17]:='G'; arrStr[18]:='H'; arrStr[19]:='I'; arrStr[20]:='J';
  arrStr[21]:='K'; arrStr[22]:='L'; arrStr[23]:='M'; arrStr[24]:='N';
  arrStr[25]:='O'; arrStr[26]:='P'; arrStr[27]:='Q'; arrStr[28]:='R';
  arrStr[29]:='S'; arrStr[30]:='T'; arrStr[31]:='U'; arrStr[32]:='V';
  arrStr[33]:='W'; arrStr[34]:='X'; arrStr[35]:='Y'; arrStr[0]:='Z';

  Result := '';
  for I := 1 to 15 do
  begin
    Randomize;
    Result := Result + Trim(arrStr[Random(36)]);
  end;
end;

function ConvertUnitStr(aUnitStr: string): string;

const
  Patt1: string = 'M2';
  NewPattern1: string = '㎡';
  Patt2: string = 'M3';
  NewPattern2: string = WideChar($00E0);

var
  SearchStr, NewStr, NewPattern, OldPattern: string;
  Offset, os1, os2: Integer;
begin
  SearchStr := AnsiUpperCase(aUnitStr);
  NewStr := aUnitStr;
  Result := '';
  while SearchStr <> '' do
  begin
    os1 := AnsiPos(Patt1, SearchStr);
    os2 := AnsiPos(Patt2, SearchStr);
    if os2 > os1 then
    begin
      if os1 <> 0 then
        Offset := os1
      else
        Offset := os2;
    end
    else
    begin
      if os2 <> 0 then
        Offset := os2
      else
        Offset := os1;
    end;
    if Offset = 0 then
    begin
      Result := Result + NewStr;
      Break;
    end;
    if Offset = os1 then
    begin
      NewPattern := NewPattern1;
      OldPattern := Patt1;
    end
    else
    begin
      NewPattern := NewPattern2;
      OldPattern := Patt2;
    end;
    // 遇到M20, M25, M30等混凝土需要剔除
    if not (NewStr[Offset + Length(OldPattern)] in ['0'..'9']) then
      Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern
    else
      Result := Result + Copy(NewStr, 1, Offset + Length(OldPattern) - 1);

    NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
    SearchStr := Copy(SearchStr, Offset + Length(OldPattern), MaxInt);
  end;
end;

function GetFileVersion:string;
var
  S: string;
  iBufSize, iLen: DWord;
  Buf: PChar;
  Value: PChar;
begin
  Result := '';
  S := ParamStr(0);
  {判断容纳文件版本信息需要一个多大的缓冲区}
  iBufSize := GetFileVersionInfoSize(PChar(S), iBufSize);
  if iBufSize > 0 then
  begin
    Buf := AllocMem(iBufSize);
    {获取文件版本信息}
    GetFileVersionInfo(PChar(S), 0, iBufSize, Buf);
    if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\FileVersion'), Pointer(Value), iLen) then
      Result := Value;
    FreeMem(Buf, iBufSize);
  end;
end;

procedure ExcuteTemplateMethod(aMethod: Pointer; Owner: TObject = nil);
begin
  Screen.Cursor := crHourGlass;
  try
    asm
      mov EDX, Owner;
      cmp EDX, 0;
      jz @NotObjectMethod;
      mov EAX, Owner;
      @NotObjectMethod: call aMethod;
    end;
  finally
    Screen.Cursor := crDefault;
  end;    
end;

function GetLocateBillsStrings: Integer;
begin
  Result := SendMessage(Application.MainForm.Handle, SM_LocateBills, 0, 0);
end;

procedure AutoSaveProjects(const aAutoSave: Boolean; const aSaveInterval: Integer);
begin
  SendMessage(Application.MainForm.Handle, SM_AutoSaveProjects, Integer(aAutoSave), aSaveInterval)
end;

function CheckProjectOpened(ASelect: Integer; const AFileName: string): Integer;
begin
  Result := SendMessage(Application.MainForm.Handle, SM_CheckProject, ASelect, LongInt(AFileName));
end;

function CompareCodes(ACode1, ABCode1, AName1, ACode2, ABCode2, AName2: string): Integer;

  function CompareDiagitCode(AsCode, ACode: string): Integer;
  var
    s1, s2: string;
    p1, p2: Integer;
    v1, v2, e1, e2: Integer;
  begin
    p1 := pos('-', AsCode);
    p2 := pos('-', ACode);
    while (p1 <> 0) and (p2 <> 0) do
    begin
      s1 := copy(AsCode, 1, p1 - 1);
      s2 := copy(ACode, 1, p2 - 1);
      if SameText(s1, s2) then
      begin
        AsCode := copy(AsCode, p1 + 1, Length(AsCode));
        ACode := copy(ACode, p2 + 1, Length(ACode));
        p1 := pos('-', AsCode);
        p2 := pos('-', ACode);
      end
      else
      begin
        Val(s1, v1, e1);
        Val(s2, v2, e2);
        if (e1 = 0) and (e2 = 0) then
          Result := v1 - v2
        else Result := CompareText(s1, s2);
        Exit;
      end;
    end;
    if (p1 = 0) and (p2 = 0) then
    begin
      Val(AsCode, v1, e1);
      Val(ACode, v2, e2);
      if (e1 = 0) and (e2 = 0) then
        Result := v1 - v2
      else Result := CompareText(AsCode, ACode);
    end
    else 
    begin
      Result := CompareText(AsCode, ACode);
    end;

  end;

  function TranslateChineseToALB(AWord: WideString): Integer;
    const
      chaArr: array [0..9] of WideString = ('十', '一', '二', '三', '四',
                                   '五', '六', '七', '八', '九');

    function ChnToNum(ANum: WideString): Integer;
    var
      J: Integer;
    begin
      Result := -1;
      for J := 0 to 9 do
      begin
        if SameText(ANum, chaArr[J]) then
        begin
          Result := J;
          if Result = 0 then Result := 10;
          Break;
        end;
      end;
    end;

  var
    I, len, icha: Integer;
  begin
    Result := 0;
    len := Length(AWord);
    for I := 1 to Len do
    begin
      icha := ChnToNum(AWord[I]);
      if icha = 10 then
      begin
        if Result = 0 then Result := 10
        else Result := Result * 10;
      end
      else
      begin
        if Result = 0 then Result := icha
        else Result := Result + icha;
      end;
    end;
  end;

  function CompareNodeCode(const ASCode, ACode: string; var AResult: Integer): Boolean;
  var
    l1, l2: Integer;
  begin
    if SameText(ASCode, ACode) then
    begin
      Result := False;
      Exit;
    end;
    Result := True;
    l1 := -1;
    l2 := -1;
    if not SameText(ASCode, '') and not SameText(ACode, '') then
    begin
      if Length(ASCode) - Length(WideString(ASCode)) > 0 then
        l1 := TranslateChineseToALB(ASCode);
      if Length(ACode) - Length(WideString(ACode)) > 0 then
        l2 := TranslateChineseToALB(ACode);
      if (l1 = -1) and (l2 = -1) then
        AResult := CompareDiagitCode(ASCode, ACode)
      else AResult := l1 - l2;
    end
    else if SameText(ASCode, '') then AResult := -1
    else if SameText(ACode, '') then AResult := 1
    else Result := False;
  end;

  function CompareNodeBCode(const ASBCode, ABCode: string; var AResult: Integer): Boolean;
  begin
    if SameText(ASBCode, ABCode) then
    begin
      Result := False;
      Exit;
    end;
    Result := True;
    if (ASBCode <> '') and (ABCode <> '') then
      AResult := CompareDiagitCode(ASBCode, ABCode)
    else if ASBCode = '' then AResult := -1
    else if ABCode = '' then AResult := 1
    else Result := False;
  end;

  function CompareNodeName(const ASName, AName: string; var AResult: Integer): Boolean;
  begin
    if (pos('…', ASName) <> 0) or (pos('…', AName) <> 0) then
      AResult := CompareText(ASName, AName) * -1
    else AResult := CompareText(ASName, AName);
  end;

begin
  Result := 0;
  if CompareNodeCode(ACode1, ACode2, Result) then Exit;

  if CompareNodeBCode(ABCode1, ABCode2, Result) then Exit;

  CompareNodeName(AName1, AName2, Result);
end;

function CheckFileEnabled(const AFullFileName: string): Boolean;
begin
  Result := False;

  if AFullFileName = '' then Exit;
  
  if FileExists(AFullFileName) then
  begin
    if MessageBox(0, pChar('该文件已存在，是否替换？'), PChar('提示'), MB_YESNO) = IDYES then
    begin
      DeleteFile(AFullFileName);
    end
    else Exit;
  end;
  Result := True;
end;

function ScRoundTo(const AValue: Double; const ADigit: Integer = -2): Double;
var
  LFactor, Offset, FixOS: Double;
begin
  LFactor := IntPower(10, ADigit);
  // 修正偏移量
  FixOS := 0;
  if LFactor < 1 then
    FixOS := IntPower(10, ADigit - 2);
  if AValue >= 0 then
    Offset := 0.5 + FixOS
  else
    Offset := -0.5 - FixOS;
  Result := Trunc((AValue / LFactor) + Offset) * LFactor;
end;

function GetSaveFile: string;
begin
  Result := '';
  with TSaveDialog.Create(nil) do
  begin
    InitialDir := ExtractFilePath(ParamStr(0));
    Filter := '(*.xls)|*.xls';
    DefaultExt := '.xls';
    if Execute then
    begin
      Result := FileName;
    end;
    Free;
  end;
end;

function OpenFileDialog(const aTitle, aDefaultExt, aFileName, aFilter: string; var aNewFileName: string): Boolean;
var
  odImport: TOpenDialog;
begin
  odImport := TOpenDialog.Create(nil);
  try
    odImport.Title := aTitle;
    odImport.DefaultExt := aDefaultExt;
    odImport.FileName := aFileName;
    odImport.Filter := aFilter;
    odImport.InitialDir := ExtractFilePath(ParamStr(0));
    if odImport.Execute then
    begin
      Result := True;
      aNewFileName := odImport.FileName;
    end
    else
      Result := False;
  finally
    odImport.Free;
  end;
end;

function SaveFileDialog(const aTitle, aDefaultExt, aFileName, aFilter: string; var aNewFileName: string): Boolean;
var
  odExport: TSaveDialog;
begin
  odExport := TSaveDialog.Create(nil);
  try
    odExport.Title := aTitle;
    odExport.DefaultExt := aDefaultExt;
    odExport.FileName := aFileName;
    odExport.Filter := aFilter;
    if odExport.Execute then
    begin
      Result := True;
      aNewFileName := odExport.FileName;
    end
    else
      Result := False;
  finally
    odExport.Free;
  end;
end;

function ProcessIsRunning(const aProcessName: string): Integer;
var
  Flag: Bool;
  Hadl: THandle;
  strProcName, strFullName: string;
  ProcessStruct: TProcessEntry32;
begin
  Result := 0;
  Hadl := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  ProcessStruct.dwSize := SizeOf(TProcessEntry32);
  Flag := Process32First(Hadl, ProcessStruct);
  while Flag do
  begin
    if ((UpperCase(ExtractFileName(ProcessStruct.szExeFile)) = UpperCase(aProcessName))
      or (UpperCase(ProcessStruct.szExeFile) = UpperCase(aProcessName))) then
    begin
      Inc(Result);
      Flag := False;
    end
    else
      Flag := Process32Next(Hadl, ProcessStruct);
  end;
  CloseHandle(Hadl);
end;

function MacAddress: string;
var
  Lib: Cardinal;
  Func: function(GUID: PGUID): Longint; stdcall;
  GUID1, GUID2: TGUID;
begin
  Result := '';
  Lib := LoadLibrary('rpcrt4.dll');
  if Lib <> 0 then
  begin
    if Win32Platform <>VER_PLATFORM_WIN32_NT then
      @Func := GetProcAddress(Lib, 'UuidCreate')
      else @Func := GetProcAddress(Lib, 'UuidCreateSequential');
    if Assigned(Func) then
    begin
      if (Func(@GUID1) = 0) and
        (Func(@GUID2) = 0) and
        (GUID1.D4[2] = GUID2.D4[2]) and
        (GUID1.D4[3] = GUID2.D4[3]) and
        (GUID1.D4[4] = GUID2.D4[4]) and
        (GUID1.D4[5] = GUID2.D4[5]) and
        (GUID1.D4[6] = GUID2.D4[6]) and
        (GUID1.D4[7] = GUID2.D4[7]) then
      begin
        Result :=
         IntToHex(GUID1.D4[2], 2) + '-' +
         IntToHex(GUID1.D4[3], 2) + '-' +
         IntToHex(GUID1.D4[4], 2) + '-' +
         IntToHex(GUID1.D4[5], 2) + '-' +
         IntToHex(GUID1.D4[6], 2) + '-' +
         IntToHex(GUID1.D4[7], 2);
      end;
    end;
    FreeLibrary(Lib);
  end;
end;

function LoadServiceQQ: string;
var
  sFileName, sServiceQQ: string;
  Ini: TIniFile;
begin
  sFileName := FixPathByAppPath('pInfo.ini');
  {$IFDEF _ScGanSu}
  sServiceQQ := '942560844';
  {$ElSE}
  sServiceQQ := '942560844';
  {$ENDIF}
  if FileExists(sFileName) then
  begin
    Ini := TIniFile.Create(sFileName);
    Result := Ini.ReadString('ProductInfo', 'ServiceQQ', sServiceQQ);
    Ini.Free;
  end
  else
    Result := sServiceQQ;
end;

function GetAveCharSize(Canvas: TCanvas): TPoint;
var
  I: Integer;
  Buffer: array[0..51] of Char;
begin
  for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
  for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
  GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
  Result.X := Result.X div 52;
end;

function ScInputBox(const ACaption, APrompt, ADefault: string): string;
begin
  Result := ADefault;
  ScInputQuery(ACaption, APrompt, Result);
end;

function ScInputQuery(const ACaption, APrompt: string;
  var Value: string; ANeedMark: Boolean): Boolean;
var
  Form: TForm;
  Prompt: TLabel;
  Edit: TEdit;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
begin
  Result := False;
  Form := TForm.Create(Application);
  with Form do
    try
      Canvas.Font := Font;
      DialogUnits := GetAveCharSize(Canvas);
      BorderStyle := bsDialog;
      Caption := ACaption;
      ClientWidth := MulDiv(180, DialogUnits.X, 4);
      Position := poScreenCenter;
      Prompt := TLabel.Create(Form);
      Font.Name := 'smartSimSun';
      Font.Size := 9;
      with Prompt do
      begin
        Parent := Form;
        Caption := APrompt;
        Left := MulDiv(8, DialogUnits.X, 4);
        Top := MulDiv(8, DialogUnits.Y, 8);
        Font.Name := 'smartSimSun';
        Font.Size := 9;
        Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
        WordWrap := True;
      end;
      Edit := TEdit.Create(Form);
      with Edit do
      begin
        Parent := Form;
        Left := Prompt.Left;
        Top := Prompt.Top + Prompt.Height + 5;
        Width := MulDiv(164, DialogUnits.X, 4);
        Font.Name := 'smartSimSun';
        Font.Size := 9;
        if ANeedMark then
          PasswordChar := '*';
        MaxLength := 255;
        Text := Value;
        SelectAll;
      end;
      ButtonTop := Edit.Top + Edit.Height + 15;
      ButtonWidth := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := '确定(&O)';
        ModalResult := mrOk;
        Default := True;
        Font.Name := 'smartSimSun';
        Font.Size := 9;
        SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
      end;
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := '取消(&C)';
        ModalResult := mrCancel;
        Cancel := True;
        Font.Name := 'smartSimSun';
        Font.Size := 9;
        SetBounds(MulDiv(92, DialogUnits.X, 4), Edit.Top + Edit.Height + 15,
          ButtonWidth, ButtonHeight);
        Form.ClientHeight := Top + Height + 13;
      end;
      if ShowModal = mrOk then
      begin
        Value := Edit.Text;
        Result := True;
      end;
    finally
      Form.Free;
    end;
end;

// 输入密码
function InputPassWord(var APwd: string): Boolean;
begin
  Result := ScInputQuery('验证密码', '请输入当前文件的密码', APwd, True);
end;

// 修改或设置密码
function SetupPassWord(var APwd: string): Boolean;
var
  NewPwd1, NewPwd2: string;
begin
  Result := ScInputQuery('设置密码', '请输入新密码'#13#10'(密码长度不得超过32个字符，区分大小写)', NewPwd1, True);
  if Result then
  begin
    Result := ScInputQuery('确认密码', '请再输入一遍新密码', NewPwd2, True);
    if Result then
    begin
      Result := CompareStr(NewPwd1, NewPwd2) = 0;
      if Result then
        APwd := NewPwd1
      else
        MessageHint(0, '两次输入的密码不同，无法设置密码。');
    end;
  end;
end;

const
  LocalIDFile = 'LocalID.dat';

function GetLocalGUID: TGUID;
var
  strFileName: string;
  stmGUIDFile: TFileStream;
begin
  strFileName := ExtractFilePath(ParamStr(0)) + LocalIDFile;
  if FileExists(strFileName) then
  begin
    stmGUIDFile := TFileStream.Create(strFileName, fmOpenRead);
    stmGUIDFile.Seek(0, soFromBeginning);
    stmGUIDFile.Read(Result, SizeOf(TGUID));
    stmGUIDFile.Free;
  end
  else
  begin
    CreateGUID(Result);
    stmGUIDFile := TFileStream.Create(strFileName, fmCreate);
    stmGUIDFile.Seek(0, soFromBeginning);
    stmGUIDFile.Write(Result, SizeOf(TGUID));
    stmGUIDFile.Free;
  end;
end;

function IsLocalGUID(AGUID: TGUID): Boolean;
var
  LocalGUID: TGUID;
begin
  Result := False;
  LocalGUID := GetLocalGUID;
  if (LocalGUID.D1 = AGUID.D1) and (LocalGUID.D2 = AGUID.D2)
      and (LocalGUID.D3 = AGUID.D3) and (Int64(LocalGUID.D4) = Int64(AGUID.D4)) then
    Result := True;
end;

function FixPathByAppPath(const AFileName: string): string;
begin
  Result := AFileName;
  if AnsiPos(':\', Result) = 0 then
  begin
    if (Result <> '') and (Result[1] = '\') then
      Delete(Result, 1, 1);
    Result := ExtractFilePath(ParamStr(0)) + Result;
  end;
end;

function GetPreCode(const ACode: string): string;
var
  bFlag: Boolean;
  I, iLen: Integer;
begin
  bFlag := True;
  Result := ACode;
  iLen := Length(ACode);
  for I := iLen downto 1 do
  begin
    if ACode[I] = '-' then
    begin
      Delete(Result, I, iLen);
      bFlag := False;
      Break;
    end;
  end;
  if bFlag then Result := '';
end;

procedure ClearPointerList(AList: TList);
var
  I: Integer;
begin
  for I := 0 to AList.Count - 1 do
  begin
    if Assigned(AList[I]) then
      Dispose(AList[I]);
  end;
  AList.Clear;
end;

procedure ClearObjectList(aList: TList);
var
  I: Integer;
begin
  for I := 0 to aList.Count - 1 do
  begin
    if Assigned(aList.List^[I]) then
      TObject(aList.List^[I]).Free;
  end;
  aList.Clear;
end;

function CompareCode(const Code1, Code2: string): Integer;
var
  iPos1  : Integer;
  iPos2  : Integer;
  iError : Integer;  
  iValue1: Integer;
  iValue2: Integer;

  sCode1: string;
  sCode2: string;
begin
  if Code1 = Code2 then
  begin
    Result := 0;
    Exit;
  end;

  sCode1 := Code1;
  sCode2 := Code2;
  iPos1 := Pos('-', sCode1);
  iPos2 := Pos('-', sCode2);

  while (iPos1 <> 0) and (iPos2 <> 0) do
  begin
    Val(sCode1, iValue1, iError);
    Val(sCode2, iValue2, iError);
    if iValue1 > iValue2 then
    begin
      Result := 1;
      Exit;
    end
    else if iValue1 < iValue2 then
    begin
      Result := -1;
      Exit;
    end
    else
      Result := 0;

    sCode1 := Copy(sCode1, iPos1 + 1, Length(sCode1));
    sCode2 := Copy(sCode2, iPos2 + 1, Length(sCode2));

    iPos1 := Pos('-', sCode1);
    iPos2 := Pos('-', sCode2);
  end;

  Val(sCode1, iValue1, iError);
  Val(sCode2, iValue2, iError);
  if iValue1 > iValue2 then
    Result := 1
  else if iValue1 < iValue2 then
    Result := -1
  else
  begin
   { if iPos1 = 0 then
      Result := -1
    else if iPos2 = 0 then
      Result := 1;    }
    // 比较最后一节，如2A和2B、A和B等 chenshilong, 2013-08-20
    if sCode1 > sCode2 then
      Result := 1
    else if sCode1 < sCode2 then
      Result := -1
    else
      Result := 0;
  end;
end;
{
function CompareCodeWithChar(const ACode1, ACode2: string; ADelimiter: Char = '-'): Integer;
var
  sgs1, sgs2: TStrings;
  I, iError1, iError2: Integer;
  iV1, iV2: Integer;
begin
  Result := 0;
  if (ACode1 = '') and (ACode2 = '') then Exit;

  sgs1 := TStringList.Create;
  sgs2 := TStringList.Create;

  sgs1.Delimiter := ADelimiter;
  sgs2.Delimiter := ADelimiter;
  sgs1.DelimitedText := ACode1;
  sgs2.DelimitedText := ACode2;

  for I := 0 to Min(sgs1.Count, sgs2.Count) - 1 do
  begin
    Val(sgs1[I], iV1, iError1);
    val(sgs2[I], iV2, iError2);
    if (iError1 = 0) and (iError2 = 0) then
      Result := iV1 - iV2
    else
      Result := CompareText(sgs1[I], sgs2[I]);
    if Result <> 0 then Break;
  end;

  if Result = 0 then
    Result := sgs1.Count - sgs2.Count;

  sgs1.Free;
  sgs2.Free;
end;   }

// 补0算法 chenshilong, 2014-04-28
function CompareCodeWithChar(const ACode1, ACode2: string; ADelimiter: Char = '-'): Integer;
  function FormatCodeSort(ACode: string; ALength: Integer = 3): string;
  var vSL, vSL2: TStringList;
    i: Integer;
    s: string;
  begin
    vSL := TStringList.Create;
    vSL2 := TStringList.Create;
    try
      vSL.Delimiter := '-';
      vSL.DelimitedText := ACode;


      vSL2.Clear;
      for i := 0 to vSL.Count - 1 do
      begin
        s := vSL[i];
        while Length(s) < ALength do
          s := '0' + s;

        // 3要排在1A的后面，结果003排到01A的前面了，所以改成：003,001A，即带字母的要多加一个0
        s := UpperCase(s);
        if (Pos('A', s) > 0) or (Pos('B', s) > 0) or (Pos('C', s) > 0) or
          (Pos('D', s) > 0) then
          s := '0' + s;

        vSL2.Add(s);
      end;

      vSL2.Delimiter := '-';
      Result := vSL2.DelimitedText;
    finally
      vSL.Free;
      vSL2.Free;
    end;
  end;

  var sCode1, sCode2: String;
begin
  sCode1 := FormatCodeSort(ACode1);
  sCode2 := FormatCodeSort(ACode2);
  if (sCode1 > sCode2) then
    Result := 1
  else if (sCode1 = sCode2) then
    Result := 0
  else
    Result := -1;
end;


function ScCompareFileVer(AVersion1: string; AVersion2: string; APartCount: Integer = 4): Integer;
var
  aVer1, aVer2: array [1..4] of Integer;
  I: Integer;
begin
  if SameText(AVersion1, AVersion2) then
  begin
    Result := 0;
    Exit;
  end;

  if ScDecodeFileVer(AVersion1, aVer1[1], aVer1[2], aVer1[3], aVer1[4]) and
      ScDecodeFileVer(AVersion2, aVer2[1], aVer2[2], aVer2[3], aVer2[4]) then
  begin
    Result := 0;
    for I := 1 to APartCount do
    begin
      if aVer1[I] > aVer2[I] then
      begin
        Result := I;
        Exit;
      end
      else if aVer1[I] < aVer2[I] then
      begin
        Result := -I;
        Exit;
      end
    end;
  end
  else
    raise Exception.Create('无法比较文件版本！');
end;

function ScDecodeFileVer(AVersion: string; var V1, V2, V3, V4: Integer): Boolean;
var
  strVer: string;

  function GetFirstVerPart(var AVer: string): Integer;
  var
    iPos, iValue, iCode: Integer;
    sFirstVer: string;
  begin
    Result := -1;
    iPos := Pos('.', AVer);
    if iPos > 0 then
    begin
      sFirstVer := Copy(AVer, 1, iPos - 1);
      Delete(AVer, 1, iPos);
    end
    else
    begin
      sFirstVer := AVer;
      AVer := '';
    end;
    Val(sFirstVer, iValue, iCode);
    if iCode = 0 then
      Result := iValue;
  end;

begin
  Result := False;
  strVer := AVersion;

  V1 := GetFirstVerPart(strVer);
  if V1 < 0 then Exit;
  V2 := GetFirstVerPart(strVer);
  if V2 < 0 then Exit;
  V3 := GetFirstVerPart(strVer);
  if V3 < 0 then Exit;
  V4 := GetFirstVerPart(strVer);
  if V4 < 0 then Exit;

  Result := True;
end;

function GetTempFilePath: string;
var
  TempPath: string;
begin
  TempPath := GetEnvironmentVariable('TMP');
  if TempPath = '' then
    TempPath := GetEnvironmentVariable('TEMP');
  if TempPath = '' then
  begin
    if not DirectoryExists(ExtractFileDir(Application.ExeName) + '\Temp') then
      CreateDir(ExtractFileDir(Application.ExeName) + '\Temp');
    TempPath := ExtractFileDir(Application.ExeName) + '\Temp';
  end;
  Result := TempPath + '\';
  // Test
// } Result := 'D:\TestTemp\';
end;

function GetTempFileName(AExt: string): string;
var
  Ext: string;
begin
  if AExt = '' then
    Ext := STempFileExt
  else
    Ext := AExt;
  Result := GetTempFilePath + GetTempName + Ext;
  while FileExists(Result) do
  begin
    Result := GetTempFilePath + GetTempName + Ext;
  end;
end;

function GetTempName(ALength: Integer): string;
const
  CodedBuf: array[0..35] of Char = ('0', '1', '2', '3', '4', '5',
  '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I',
  'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V',
  'W', 'X', 'Y', 'Z');
var
  Temp: string;
  Num: Integer;
begin
  Randomize;
  Temp := '';
  while Length(Temp) < ALength do
  begin
    Num := Random(37);
    If Num <> 36 Then
      Temp := Temp + CodedBuf[Num];  // 0..35
  end;
  Result := Temp;
end;

function CreateFullDir(ADir: string): Boolean;
var
  strTemp, strDir: string;
  iPos: Integer;
  bInit, bResult: Boolean;
begin
  Result := False;
  bInit := False;
  strTemp := ADir;
  iPos := Pos(':\', strTemp);
  if iPos = 0 then
  begin
    //if strTemp[1] <> '\' then
    //  strTemp := '\' + strTemp;
    if strTemp[1] = '\' then
      Delete(strTemp, 1, 1);
    strTemp := ExtractFilePath(Application.ExeName) + strTemp;
  end;
  strDir := Copy(strTemp, 1, 3);
  Delete(strTemp, 1, 3);
  while strTemp <> '' do
  begin
    iPos := Pos('\', strTemp);
    if (iPos = 0) and (strTemp <> '') then
    begin
      strDir := strDir + strTemp;
      strTemp := '';
    end
    else
    begin
      strDir := strDir + Copy(strTemp, 1, iPos);
      Delete(strTemp, 1, iPos);
    end;
    bResult := DirectoryExists(strDir);
    if not bResult then
      bResult := CreateDir(strDir);
    if (not bInit) and bResult then
    begin
      bInit := True;
      Result := True;
    end;
    if (not bResult) and Result then
      Result := False;
  end;
end;

procedure FixFileExt(var AFileName: string; const AExt: string; AutoReplace: Boolean);
var
  OldExt: string;
  OldExtLen: Integer;
begin
  OldExt := ExtractFileExt(AFileName);
  if not SameText(OldExt, AExt) then
  begin
    if AutoReplace then
    begin
      OldExtLen := Length(OldExt);
      Delete(AFileName, Length(AFileName) - OldExtLen + 1, OldExtLen);
      AFileName := AFileName + AExt;
    end
    else
      AFileName := AFileName + AExt;
  end;
end;

function SystemDateTime: TDateTime;
begin
  Result := Now;
  if _ServerDateTime > 0 then
    Result := _ServerDateTime;
end;

function CompileDateTime: TDateTime;
const
  SmartCostCompileDate = '2009-10-19';
begin
  try
    Result := StrToDate(SmartCostCompileDate);
  except
    Result := 40105;
  end;
end;

function BillCategory(ACode, AB_Code: string): TBillCategory;
begin
  ACode := Trim(ACode);
  AB_Code := Trim(AB_Code);

  // 预算项目节 (只要Code不为空皆认为是)
  if (ACode <> '') then
    Result := bcYSXMJ
  // 清单子目号 (Code为空B_Code不为空)
  else if (AB_Code <> '') then
    Result := bcQDZMH
  // Code、B_Code都为空
  else
    Result := bcTZGCL;
end;

{-------------------------------------------------------------------------------
  方法:  FormatBCodeAlpha
  说明:  将B_Code值中含“10”、“11”的替换成“A”、“B”等字母，便于排序。
         最前头的数字不要替换，因为报表中需要取第一位数字分章。
         B_Code形如“205-1-20-1”。
  作者:  Chenshilong, 2010-5-6 16:10:34
-------------------------------------------------------------------------------}
function FormatBCodeAlpha(AB_Code: string): String;
var
  vSL: TStringList;
  i, iTemp: Integer;
  sTemp, sValue: string;

  procedure SplitString(Source, Separator: string; AStringList: TStringList);
  var
    Po: byte;
  begin
    while Pos(Separator, Source) > 0 do
    begin
      Po := Pos(Separator, Source);
      AStringList.add(Copy(Source, 1, Po - 1));
      Source := Copy(Source, Po + length(Separator), length(Source) - Po);
    end;
    AStringList.Add(source);
  end;

begin
  if Trim(AB_Code) = '' then
  begin
    Result := '';
    Exit;
  end;
  
  sTemp := '';
  sValue := '';
  vSL := TStringList.Create;
  SplitString(AB_Code, '-', vSL);
  // 如果B_Code不含“-”，则直接返回AB_Code值。
  if vSL.Count < 2 then
    sValue := AB_Code
  else
  begin
    for i := 0 to vSL.Count - 1 do
    begin
      // 只替换两位数
      if Length(vSL[i]) = 2 then
      begin
        try
          iTemp := StrToInt(vSL[i]);
          if not IntToIdent(iTemp, sTemp, NumStrToAlpha) then
            sTemp := vSL[i];
        except
          sTemp := vSL[i];
        end;
      end
      else
      begin
        sTemp := vSL[i];
      end;
      if sValue <> '' then
        sValue := sValue + '-' + sTemp
      else
        sValue := sTemp;
    end;
  end;

  Result := sValue;
end;


end.