rich_sys.pas

一个地方税务征收管理系统

      begin
        if SString[WhereP - i] = '0' then
        begin
          if (i = 5) or (i = 9) then
          begin
            if i = 5 then TempString := '万' + TempString;
            if i = 9 then TempString := '亿' + TempString;
          end
          else
          begin
            if PT <> 0 then TempString := '零' + TempString;
          end;
        end
        else
        begin
          if (i = 5) or (i = 9) then
          begin
            T := (i mod 4) - 1;
            if T = -1 then T := 3;
            if i = 5 then
              TempString := ChineseNumber[StrToInt(SString[WhereP - i]), T] +
                '万'
                + TempString;
            if i = 9 then
              TempString := ChineseNumber[StrToInt(SString[WhereP - i]), T] +
                '亿'
                + TempString;
          end
          else
          begin
            T := (i mod 4) - 1;
            if T = -1 then T := 3;
            TempString := ChineseNumber[StrToInt(SString[WhereP - i]), T] +
              TempString;
          end;
        end;
      end;
      if SString[WhereP - i] <> '-' then PT := StrToInt(SString[WhereP - i]);
    end;
  end;
  {  else begin
           if Length(SString)>WhereP then
           begin
             if WhereP=1 then TempString:='零'+TempString;
             if WhereP=2 then
             begin
               if SString[1]='-' then TempString:='负零'+TempString
               else TempString:=ChineseNumber[StrToInt(SString[1]),0]+TempString;
             end;
           end;
         end;}
  if WhereP = 2 then
  begin
    TempString := ChineseNumber[StrToInt(SString), 0];
    if SString = '0' then TempString := '零';
  end; //<- end if
  //______________________
  if SString <> '' then TempString := TempString + StrZheng; //'圆';
  if (WhereP <> 0) then
  begin
    if (Length(SString) - WhereP) > 0 then
    begin
      if SString[WhereP + 1] <> '0' then
        TempString := TempString + JiaoNumber[StrToInt(SString[WhereP + 1])];
      if (Length(SString) - WhereP) > 1 then
      begin
        if SString[WhereP + 2] <> '0' then
          TempString := TempString + FenNumber[StrToInt(SString[WhereP + 2])];
      end;
    end;
    //____________

  end;
  if SString <> '' then
    DString := TempString
  else
    DString := '';
  TurnMoneyStr := DString;
end;

function GET_computer_name: string;
var
  Buffer: array[0..63] of char;
  phe: PHostEnt;
  GInitData: TWSADATA;
begin
  WSAStartup($101, GInitData);
  GetHostName(Buffer, SizeOf(Buffer)); // var Buffer : array [0..63] of char;
  phe := GetHostByName(buffer); // var phe  : PHostEnt;
  Result := UpperCase(phe.h_name);
end;

function GET_COMPUTER_IP: string;
type
  TaPInAddr = array[0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: array[0..63] of char;
  I: Integer;
  GInitData: TWSADATA;
begin
  WSAStartup($101, GInitData);
  Result := '';
  GetHostName(Buffer, SizeOf(Buffer));
  phe := GetHostByName(buffer);
  if phe = nil then Exit;
  pptr := PaPInAddr(Phe^.h_addr_list);
  I := 0;
  while pptr^[I] <> nil do
  begin
    result := UpperCase(StrPas(inet_ntoa(pptr^[I]^)));
    Inc(I);
  end;
  WSACleanup;
end;

// 取汉字拼音

function Get_HzPy(var Hz: string): string; //*** 取汉字拼音 ***
var
  C1, Len1, C2: Integer;
  ir: Word;
  FResult: string;
begin
  FResult := '';
  C1 := 1;
  Len1 := Length(Hz);
  while (C1 <= Len1) do
  begin
    if (ord(Hz[C1]) >= 160) and (ord(Hz[C1 + 1]) >= 160) then
    begin
      ir := (ord(Hz[C1]) - 160) * 100 + ord(Hz[C1 + 1]) - 160;
      C2 := 1;
      while (C2 <= 26) do
      begin
        if (ir >= ChinaCode[C2, 0]) and (ir <= ChinaCode[C2, 1]) then
        begin
          FResult := FResult + UpCase(chr(C2 + ord('a')));
          break;
        end;
        C2 := C2 + 1;
      end;
    end;
    C1 := C1 + 2;
  end;
  Result := UpperCase(FResult);
end;

function Get_WinSysPath: string; //*** 取WINDOWS的SYSTEM路径 ***
var
  SysPath: PChar;
begin
  GetMem(SysPath, 256);
  GetSystemDirectory(SysPath, 256);
  Result := SysPath;
end;
//------------------------------------------------------------------------------

function Get_WindowsPath: string; //*** 取WINDOWS路径 ***
var
  WinPath: PChar;
begin
  GetMem(WinPath, 256);
  GetWindowsDirectory(WinPath, 256);
  Result := WinPath;
end;

function string_qd0str(const count, num: integer): string;
var
  s1, s2: string;
begin
  s1 := IntToStr(Num);
  s2 := '00000000000000000000';
  if (Length(s1) >= count) then
    s2 := ''
  else
    if (count > 20) then
      SetLength(S2, 20 - Length(s1))
    else
      SetLength(S2, count - Length(s1));

  Result := S2 + S1;
end;

function string_IsIntStr(const S: string): boolean;
begin
  Result := StrToIntDef(S, 0) = StrToIntDef(S, 1);
end;

function string_rand_str(maxlength: integer; Fupp, Flow, Fnumber: bool): string;
var
  i: Byte;
  s: string;
begin
  {if you want to use the 'A..Z' characters}
  if Fupp then
    s := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
  else
    s := '';

  {if you want to use the 'a..z' characters}
  if Flow then
    s := s + 'abcdefghijklmnopqrstuvwxyz';

  {if you want to use the '0..9' characters}
  if Fnumber then
    s := s + '0123456789';
  if s = '' then exit;

  Result := '';
  for i := 0 to maxlength - 1 do
    Result := Result + s[Random(Length(s) - 1) + 1];
end;

function NET_isOnline: bool;
var
  b: array[0..4] of Byte;
begin
  with TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey('System\CurrentControlSet\Services\RemoteAccess', False);
    ReadBinaryData('Remote Connection', b, 4);
  finally
    Free;
  end;
  if b[0] = 1 then
    Result := true
  else
    Result := false;
end;

function File_operation(mfile: string): bool;
var
  T: TSHFileOpStruct;
  P: string;
begin
  {注意：
  1. 给出文件的绝对路径名，否则可能不能恢复；
    2.
      MS的文档说对于多个文件，每个文件名必须被#)字符分隔，而整个字符串必须用两个#0结束。
 }

  P := mfile;
  with T do
  begin
    Wnd := 0;
    wFunc := FO_DELETE;
    pFrom := Pchar(P);
    fFlags := FOF_ALLOWUNDO
  end;
  try
    SHFileOperation(T);
    Result := true;
  except
    Result := false;
  end;
end;

procedure shell_open_explore(mpath: string);
begin
  //  ShellExecute(0, pchar(mpath), nil, nil, SW_SHOWNORMAL);
end;

procedure system_disable_syskey;
var
  temp: Integer;
begin
  SystemParametersInfo(Spi_screensaverrunning, 1, @temp, 0);
end;

procedure system_enable_syskey;
var
  temp: Integer;
begin
  SystemParametersInfo(Spi_screensaverrunning, 0, @temp, 0);
end;

function system_Get_CPUSpeed: Double;
const
  DelayTime = 500; // measure time in ms
var
  TimerHi, TimerLo: DWORD;
  PriorityClass, Priority: Integer;
begin
  PriorityClass := GetPriorityClass(GetCurrentProcess);
  Priority := GetThreadPriority(GetCurrentThread);

  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

  Sleep(10);
  asm
  dw 310Fh // rdtsc
  mov TimerLo, eax
  mov TimerHi, edx
  end;
  Sleep(DelayTime);
  asm
  dw 310Fh // rdtsc
  sub eax, TimerLo
  sbb edx, TimerHi
  mov TimerLo, eax
  mov TimerHi, edx
  end;
  SetThreadPriority(GetCurrentThread, Priority);
  SetPriorityClass(GetCurrentProcess, PriorityClass);
  Result := TimerLo / (1000.0 * DelayTime);
end;

procedure system_change_computername(new_name: string);
begin
  SetComputerName(pchar(new_name));
end;

procedure datetime_dialog_datetime;
begin
  // ShellExecute(Handle, 'open', 'control', 'date/time', nil, SW_SHOW);
end;

function datatime_get_Week(const TDT: TDateTime): Word;
var
  Y, M, D: Word;
  dtTmp: TDateTime;
begin
  DecodeDate(TDT, Y, M, D);
  dtTmp := EnCodeDate(Y, 1, 1);
  Result := (Trunc(TDT - dtTmp) + (DayOfWeek(dtTmp) - 1)) div 7;
  if Result = 0 then
    Result := 51
  else
    Result := Result - 1;
end;

function datetime_get_DaysInMonth(ADate: TDateTime): Integer;
var
  MyMonth,
    MyYear,
    MyDay: Word;
  MyDayTable: TDayTable;
  tmpBool: Boolean;
begin
  DecodeDate(ADate, MyYear, MyMonth, MyDay);
  tmpBool := IsLeapYear(MyYear);
  MyDayTable := MonthDays[tmpBool];
  Result := MyDayTable[MyMonth];
end;

procedure system_deley(mm: integer);
var
  NumSec: SmallInt;
  StartTime: TDateTime;
begin
  StartTime := now;
  repeat
    //    Application.ProcessMessages;
  until Now > StartTime + mm * (1 / 24 / 60 / 60);
end;

function datetime_is_legit(mdatetime: string): bool;
var
  t: TDateTime;
begin
  try
    t := StrToDateTime(mdatetime);
    Result := true;
  except
    Result := false;
  end;
end;

procedure system_monitor_close;
begin
  //  SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);
end;

procedure system_monitor_open;
begin
  //  SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1);
end;

function system_ScreenSaver_On: bool;
var
  b: bool;
begin
  result := false;
  if SystemParametersInfo(SPI_GETSCREENSAVEACTIVE, 1, @b, 0) <> true then exit;
  if not b then exit;
  //  PostMessage(GetDesktopWindow, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
  result := true;
end;

function system_ScreenSaver_off: bool;
var
  b: bool;
begin
  result := false;
  if SystemParametersInfo(SPI_GETSCREENSAVEACTIVE, 0, @b, 0) <> true then exit;
  if not b then exit;
  //  PostMessage(GetDesktopWindow, WM_SYSCOMMAND, SC_SCREENSAVE, 0); //执行
  result := true;
end;

function string_IsCurrentStr(const s: string): boolean;
begin
  Result := StrToFloatDef(S, 0) = StrToFloatDef(S, 1);
end;

function SQL_INSERT(MComponent: TComponent): string;
begin
  if MComponent is TEdit then
    Result := '''' + (tedit(MComponent)).Text + ''''
  else
    if MComponent is TMemo then
      Result := '''' + (TMemo(MComponent)).Lines.Text + ''''
    else
      if MComponent is TComboBox then
        Result := '''' + (TComboBox(MComponent)).Text + '''';

end;

function SQL_update(mfield: string; MComponent: TComponent): string;
begin
  if MComponent is TEdit then
    Result := mfield + '=' + '''' + (tedit(MComponent)).Text + ''''
  else
    if MComponent is TMemo then
      Result := mfield + '=' + '''' + (TMemo(MComponent)).Lines.Text + ''''
    else

      if MComponent is TComboBox then
        Result := mfield + '=' + '''' + (TComboBox(MComponent)).Text +
          ''''
end;

procedure shell_open_file(mhandle: THandle; mfilename: string);
begin
  ShellExecute(mhandle, 'open', pchar(mfilename), nil, nil, SW_NORMAL);
end;

function string_sqlText(const s: string): string;
begin
  Result := '''' + s + '''';
end;

function str_Encrypt(const Instring: string): string;
begin
  Result := Encrypt(Instring, StartKey, MultKey, AddKey);
end;

function str_Decrypt(const Instring: string): string;
begin
  Result := Decrypt(Instring, StartKey, MultKey, AddKey);
end;

procedure ini_write_encript(key: string; Avalue: string);
begin
  with TIniFile.Create(ExtractFilePath(Application.ExeName) + 'sets.ini') do
    WriteString('system', Key, Encrypt(AValue, StartKey, MultKey, AddKey));
end;

function ini_read_encript(key: string; err: string): string;
begin
  with TIniFile.Create(ExtractFilePath(Application.ExeName) + 'sets.ini') do
    Result := Decrypt(ReadString('system', key, err), StartKey, MultKey,
      AddKey);
end;
end.