xeduser.pas

在查询汉字拼音首字母时需要取得汉字的拼音

    PRINTER_STATUS_PRINTING: S := 'AAAAA';
    PRINTER_STATUS_PROCESSING: S := 'AAAAA';
    PRINTER_STATUS_TONER_LOW: S := 'AAAAA';
//    PRINTER_STATUS_UNAVAILABLE        : S := 'AAAAA';
    PRINTER_STATUS_USER_INTERVENTION: S := 'AAAAA';
    PRINTER_STATUS_WAITING: S := 'AAAAA';
    PRINTER_STATUS_WARMING_UP: S := 'AAAAA';
  end;
  TellME(S);
  PrintState := ST;
end;

function CopyFiles(H: Integer; F1, F2: string): Boolean;
var
  Path1, Path2: array[0..128] of Char;
  OPStruc: SHFileOpStruct;
begin
  fillchar(Path1, 129, 0);
  fillchar(Path2, 129, 0);
  StrpCopy(Path1, F1);
  StrpCopy(Path2, F2);
  with OpStruc do begin
    Wnd := 0;
    wFunc := FO_COPY;
    OpStruc.pFrom := @Path1;
    pTo := @Path2;
    fFlags := FOF_NOCONFIRMATION + FOF_NOCONFIRMMKDIR;
    fAnyOperationsAborted := False;
    hNameMappings := nil;
    lpszProgressTitle := 'aaa';
  end;

{    FOF_ALLOWUNDO :;
    FOF_CONFIRMMOUSE:;
    FOF_FILESONLY:;
    FOF_MULTIDESTFILES:;
    FOF_NOCONFIRMATION:;
    FOF_NOCONFIRMMKDIR:;
    FOF_RENAMEONCOLLISION:;
    FOF_SILENT:;
    FOF_SIMPLEPROGRESS:;
    FOF_WANTMAPPINGHANDLE:;
}
  Result := ShFileOperation(OpStruc) = 0;
end;

function CPUID_Ready: Boolean;
asm
	PUSHFD			{direct access to flags no possible, only via stack}
	POP	EAX		{flags to EAX}
	MOV	EDX,EAX		{save current flags}
	XOR	EAX,$200000	{not ID bit}
	PUSH	EAX		{onto stack}
	POPFD			{from stack to flags, with not ID bit}
	PUSHFD			{back to stack}
	POP	EAX		{get back to EAX}
	XOR	EAX,EDX		{check if ID bit affected}
	JZ	@1		{no, CPUID not availavle}
	MOV	AL,True		{Result=True}
	@1:
end;

function GetCPUID: TCPUID;
asm
	PUSH	EBX         	{Save affected register}
	PUSH	EDI
	MOV	EDI,EAX     	{@Resukt}
	MOV	EAX,1
	DW	$A20F       	{CPUID Command}
	STOSD			{CPUID[1]}
	MOV	EAX,EBX
	STOSD               	{CPUID[2]}
	MOV	EAX,ECX
	STOSD               	{CPUID[3]}
	MOV	EAX,EDX
	STOSD         	{CPUID[4]}
	POP	EDI		{Restore registers}
	POP	EBX
end;

function GetCPUVendor: TVChar;
asm
	PUSH	EBX		{Save affected register}
	PUSH	EDI
	MOV	EDI,EAX	{@Result (TVChar)}
	MOV	EAX,0
	DW	$A20F		{CPUID Command}
	MOV	EAX,EBX
	XCHG	EBX,ECX 	{save ECX Result}
	MOV	ECX,4
@1:	STOSB
	SHR	EAX,8
	LOOP	@1
	MOV	EAX,EDX
	MOV	ECX,4
@2:	STOSB
	SHR	EAX,8
	LOOP	@2
	MOV	EAX,EBX
	MOV	ECX,4
@3:	STOSB
	SHR	EAX,8
	LOOP	@3
	POP	EDI		{Restore registers}
	POP	EBX
end;

function FileVersion(S: string): string;
var
  L, Len: longword;
  Sz: Word;
  Buf: Pointer;
  Ver: ^TVSFixedFileInfo;
begin
  Sz := GetFileVersionInfoSize(PChar(S), L);
  if Sz = 0 then Result := '' else
  begin
    GetMem(Buf, Sz);
    GetFileVersionInfo(PChar(S), 0, Sz, Buf);
    VerQueryValue(Buf, '\', Pointer(Ver), Len);
    Result :=
      IntToStr(HIWORD(Ver.dwFileVersionMS)) + '.' +
      IntToStr(LOWORD(Ver.dwFileVersionMS)) + '.' +
      IntToStr(HIWORD(Ver.dwFileVersionLS)) + '.' +
      IntToStr(LOWORD(Ver.dwFileVersionLS));
    FreeMem(Buf, Sz);
  end;
end;

function DiskID(Drive: PChar): DWORD;
var
  Tmp1, Tmp2: DWord;
  DW: DWord;
begin
  GetVolumeInformation(Drive,
    nil, 0, @DW, Tmp1, Tmp2, nil, 0);
  Result := DW;
end;

function EncodeME(R: Integer): string;
var
  H1, H2, S: string;
  I, L: Integer;
begin
  if R = 0 then begin
    Result := '';
    Exit;
  end;
  S := IntToStr(R);
  L := Length(S);
  for I := 1 to L do Inc(S[I], 188);
  H1 := Chr(L * L + 177);
  H2 := Chr(L * L + 188);
  Result := H1 + H2 + S;
end;

function DecodeME(S: string): Integer;
var
  I, L: Integer;
begin
  if (S = '') or SettUser then begin
    Result := 0;
    Exit;
  end;
  L := Length(S) - 2;
  Delete(S, 1, 2);
  for I := 1 to L do Dec(S[I], 188);
  Result := StrToInt(S);
end;

function EncodeStr(S: string): string;
var
  I: Integer;
  R: Word;
  P: string;
begin
  S := S + '123456789012345678';
  R := 4444;
  if R = 4444 then ;
  P := '';
  for I := 1 to 16 do begin
    if S[I] = #0 then S[I] := Chr(I + 65);
    R := Trunc(Sqrt((987 * Ord(S[I]) * 9)));
    R := R mod 1000;
    while R < 048 do R := R + 20 + I;
    while R > 090 do R := R - 20 - I;
    while R < 048 do R := R + 20 + I;
    P := P + Chr(R);
  end;
  Result := P;
end;

function OutofDate: Boolean;
const
  KeyName = 'FirstDate';
var
  Reg: TRegistry;
  P: string;
  i: Word;
  Date0: TDate;
begin
  Reg := TRegistry.Create;
  Reg.RootKey := HKey_Local_Machine;
  Reg.OpenKey(KeyPath + PassKey, True);
  if Reg.ValueExists(KeyName) then begin
    P := Reg.ReadString(KeyName);
    for I := 1 to Length(P) do
      P[i] := Chr((ord(P[i]) - 25 - I) xor I);
    Date0 := StrToDate(P);
    Result := Date - Date0 > 40;
  end else begin
    P := FormatDateTime('yyyy-mm-dd', Date);
    for I := 1 to Length(P) do
      P[i] := Chr(ord(P[i]) xor I + 25 + I);
    Reg.WriteString(KeyName, P);
    Result := False;
  end;
  Reg.CloseKey;
  Reg.Free;
end;

function HasRegister: Boolean;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  Reg.RootKey := HKey_Local_Machine;
  Reg.OpenKey(KeyPath + PassKey, False);
  RegPass := Copy(Reg.ReadString('PassWord'), 1, 16);
  if RegPass = '' then Result := False else
    Result := RegPass = EncodeStr(
      IntToStr(DiskID('C:\') xor DiskID('D:\') xor $88654321));
  Reg.CloseKey;
  Reg.Free;
end;

procedure RedrawForm(Sender: TObject);
var
  H: THandle;
  DC: HDC;
begin
  H := FindWindow('Progman', nil);
  DC := GetWindowDC(H);
  Sendmessage(H, wm_EraseBkGnd, DC, 0);
  SendMessage(H, wm_Paint, DC, 0);
  RedrawWindow(H, nil, 0, RDW_ERASE or RDW_INVALIDATE
    or RDW_ALLCHILDREN);
  ReleaseDC(H, DC);
end;

procedure LoadSite(Form: TForm; Key: string);
var
  R: TRegistry;
  Place: TWindowPlacement;
  Hnd: THandle;
  SC: Word;
begin
  Hnd := Form.Handle;
  R := TRegistry.Create;
  if R.OpenKey('SoftWare\X-Ware\' + Key, False) then begin
    R.ReadBinaryData('Position', Place, Sizeof(Place));
    SC := Place.showCmd;
    Place.showCmd := 0;
    SetWindowPlacement(Hnd, @Place);
    if SC = 3 then Form.WindowState := wsMaximized;
  end;
  R.Free;
end;

procedure SaveSite(Form: TForm; Key: string);
var
  Place: TWindowPlacement;
  R: TRegistry;
begin
  Place.length := Sizeof(Place);
  if not GetWindowPlacement(Form.Handle, @Place) then Exit;
  R := TRegistry.Create;
  if R.OpenKey('SoftWare\X-Ware\' + Key, True) then begin
    R.WriteBinaryData('Position', Place, Sizeof(Place));
  end;
  R.Free;
end;

function GetPYStr(HZStr: WideString): string;
var
  S: string;
  I: Word;
  C: Char;
begin
  Result := '';
  for I := 1 to Length(HZStr) do begin
    S := HZStr[I];
    if Length(S) = 1 then C := S[1] else
      case WORD(S[1]) * 256 + Byte(S[2]) of
        $B0A1..$B0C4: C := 'A'; $B0C5..$B2C0: C := 'B';
        $B2C1..$B4ED: C := 'C'; $B4EE..$B6E9: C := 'D';
        $B6EA..$B7A1: C := 'E'; $B7A2..$B8C0: C := 'F';
        $B8C1..$B9FD: C := 'G'; $B9FE..$BBF6: C := 'H';
        $BBF7..$BFA5: C := 'J'; $BFA6..$C0AB: C := 'K';
        $C0AC..$C2E7: C := 'L'; $C2E8..$C4C2: C := 'M';
        $C4C3..$C5B5: C := 'N'; $C5B6..$C5BD: C := 'O';
        $C5BE..$C6D9: C := 'P'; $C6DA..$C8BA: C := 'Q';
        $C8BB..$C8F5: C := 'R'; $C8F6..$CBF9: C := 'S';
        $CBFA..$CDD9: C := 'T'; $CDDA..$CEF3: C := 'W';
        $CEF4..$D1B8: C := 'X'; $D1B9..$D4D0: C := 'Y';
        $D4D1..$D7F9: C := 'Z'; else C := '?';
      end;
    Result := Result + C;
  end;
end;

function CoinStr(SumCoin: Real): string;
const
  UY: wideString = '分角元十百千万十';
  UD: wideString = '零壹贰叁肆伍陆柒捌玖';
var
  S, Y: string;
  i, j, L: Integer;
begin
  Y := IntToStr(round(SumCoin * 100));
  S := '整';
  L := Length(Y);
  for i := L downto 1 do
  begin
    j := StrToInt(Y[I]);
    S := UD[j + 1] + '' + UY[L - I + 1] + S;
  end;
  S := FormatFloat('"总计金额："0.00" 元"', SumCoin) + ',(大写):' + S;
  Result := S;
end;

function OICQ(const FName: string = 'C:\Program Files\Tencent\Dat\OICQ2000.CFG'): string;
var
  I, F1, Size, Len: Integer;
  Buffer: array of Byte;
begin
  f1 := FileOpen(FName, fmOpenRead);
  Size := FileSeek(f1, 0, 2); //文件长度
  SetLength(Buffer, Size);
  FileSeek(f1, 0, 0);
  FileRead(f1, Buffer[1], Size);
  FileClose(f1);
  Len := Buffer[5];
  for i := 0 to Len do Buffer[i + 9] := not Buffer[i + 9];
  Result := PChar(@Buffer[9]);
  SetLength(Buffer, 0);
end;

procedure DeskShort(PathName: string; LinkName: WideString);
var
  MYObject: IUnknown;
  SLink: IShellLink;
  PFile: IPersistFile;
  P_IDL: PItemIDList;
  DeskTop: array[0..MAX_PATH] of Char;
begin
  MYObject := CreateComObject(CLSID_ShellLink);
  SLink := MYObject as IShellLink;

  // 以下获取 DeskTop 目录
  SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, P_IDL);
  SHGetPathFromIDList(P_IDL, DeskTop);
  LinkName := '\' + LinkName;
  LinkName := DeskTop + LinkName;

  SLink.SetPath(pChar(PathName));
  SLink.SetWorkingDirectory(pChar(ExtractFileDir(PathName)));

  PFile := MYObject as IPersistFile;
  PFile.Save(pWChar(LinkName), True);
end;

function GetQuick(Input: string): string;
var
  LinkName: string;
  PathName: PChar;
  MYObject: IUnknown;
  SLink: IShellLink;
  PFile: IPersistFile;
//  P_IDL: PItemIDList;
//  DeskTop: array[0..MAX_PATH] of Char;
  AAA2: WIN32_FIND_DATA;
begin
  MYObject := CreateComObject(CLSID_ShellLink);
  // 以下获取 DeskTop 目录
  LinkName := Input;
  PFile := (MYObject) as IPersistFile;
  PFile.Load(PWideChar(WideString(LinkName)), S_OK);

  SLink := IShellLink(MYObject);
  GetMem(PathName, 255);
  SLink.GetPath(PathName, 255, AAA2, SLGP_UNCPRIORITY);
  Result := PathName;
//  Result.Add('目标名称：'#13#10 + PathName);
//  SLink.GetWorkingDirectory(PChar(PathName), 255);
//  Result.Add('实际位置：'#13#10 + PathName);
  FreeMem(PathName, 255);
end;

initialization
  PrHandle := PrintHandle;
  ExePath := ExtractFilePath(ParamStr(0));
  IniPath := ChangeFileExt(ParamStr(0), '.INI');
  Registed := HasRegister;
end.