rich_sys.pas

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

unit RICH_SYS;
interface

uses Windows, StdCtrls, forms, registry, winsock, Classes, Sysutils, IniFiles,
  shellapi;

type
  TCPUID = array[1..4] of Longint;
  TCPUVendor = array[0..11] of Char;

function GetCPUID: TCPUID; assembler; register;
function GetCPUVendor: TCPUVendor; assembler; register;
function GetcpuID_Asstring: string;

function incno(str: string; Mstep: Integer): string;

function LeftStr(s: string; k: integer): string;
function RightStr(s: string; k: integer): string;
function MidStr(s: string; p, k: integer): string;
function LeftPosStr(s, s1: string; n: integer): integer;
function RightPosStr(s, s1: string; n: integer): integer;
function StripAllStr(s, s1: string): string;
function StripStr(s, s1: string; n: integer): string;
function TrimLeftStr(s, s1: string; n: integer): string;
function TrimRightStr(s, s1: string; n: integer): string;
function PadLeftStr(s, s1: string; k: integer): string;
function PadRightStr(s, s1: string; k: integer): string;
function PadMidStr(s, s1: string; p, k: integer): string;
function InsertLeftStr(s, s1: string; n: integer): string;
function InsertRightStr(s, s1: string; n: integer): string;
function InsertMidStr(s, s1: string; p, n: integer): string;
function ReplaceAllStr(s, s1, s2: string): string;
function ReplaceStr(s, s1, s2: string; n: integer): string;
function ConvToUpperStr(s: string; p, k: integer): string;
function ConvToLowerStr(s: string; p, k: integer): string;
function CountStr(s, s1: string): integer;
function IIfStr(b: boolean; s, s1: string): string;
function ValidChrStr(s, s1: string): boolean;
function ValidIntStr(s: string; a, b: integer; var i: integer): boolean;
function ValidLenStr(s: string; a, b: integer): boolean;
function TokenStr(s, s1: string; n: integer): string;

function Encrypt(const InString: string; StartKey, MultKey, AddKey: Integer):
  string;
function Decrypt(const InString: string; StartKey, MultKey, AddKey: Integer):
  string;
function str_Encrypt(const Instring: string): string;
function str_Decrypt(const Instring: string): string;

function TurnMoneyStr(fMoneyNumber: Double): string;

function string_qd0str(const count, num: integer): string;
//在前面加0直到nmum位
function string_sqlText(const s: string): string;
function string_IsIntStr(const S: string): boolean; //是否可转化为INT
function string_IsCurrentStr(const s: string): boolean;
function string_rand_str(maxlength: integer; Fupp, Flow, Fnumber: bool): string;

//*** 将数值转换成Money字符串 ***

//net
function NET_isOnline: bool;
function GET_computer_name: string;
function GET_COMPUTER_IP: string;

function Get_HzPy(var Hz: string): string;

//file
function File_operation(mfile: string): bool;
function Get_WinSysPath: string; //*** 取WINDOWS的SYSTEM路径 ***
function Get_WindowsPath: string; //*** 取WINDOWS路径 ***

//shell api
procedure shell_open_explore(mpath: string);
procedure shell_open_file(mhandle: THandle; mfilename: string);

//system
procedure system_disable_syskey;
procedure system_enable_syskey;
function system_Get_CPUSpeed: Double;
procedure system_change_computername(new_name: string);
procedure system_deley(mm: integer);
procedure system_monitor_close;
procedure system_monitor_open;
function system_ScreenSaver_On: bool;
function system_ScreenSaver_off: bool;

//datetime
procedure datetime_dialog_datetime;
function datatime_get_Week(const TDT: TDateTime): Word;
function datetime_get_DaysInMonth(ADate: TDateTime): Integer;
function datetime_is_legit(mdatetime: string): bool;

//sql
function SQL_INSERT(MComponent: TComponent): string;
function SQL_update(mfield: string; MComponent: TComponent): string;

procedure ini_write_encript(key: string; Avalue: string);
function ini_read_encript(key: string; err: string): string;
implementation

const
  ASCII_UPPER_A = 65;
  ASCII_UPPER_Z = 90;
  ASCII_LOWER_A = 97;
  ASCII_LOWER_Z = 122;

  StartKey = 981; {Start default key}
  MultKey = 12674; {Mult default key}
  AddKey = 35891; {Add default key}

  ChinaCode: array[0..25, 0..1] of Integer = ((1601, 1636), (1637, 1832), (1833,
    2077),
    (2078, 2273), (2274, 2301), (2302, 2432), (2433, 2593), (2594, 2786), (9999,
    0000),
    (2787, 3105), (3106, 3211), (3212, 3471), (3472, 3634), (3635, 3722), (3723,
    3729),
    (3730, 3857), (3858, 4026), (4027, 4085), (4086, 4389), (4390, 4557), (9999,
    0000),
    (9999, 0000), (4558, 4683), (4684, 4924), (4925, 5248), (5249, 5589));

function MatchStr(s, s1: string; var i, j: integer;
  ls, ls1: integer): boolean;
{------------------------------------------------------------------------------}
{ Returns true if s1 is found at position i in s. }
var
  k: integer;
begin
  j := i;
  k := 1;
  while (s[j] = s1[k]) and (j <= ls) and (k <= ls1) do
  begin
    inc(j);
    inc(k);
  end;
  Result := (k = ls1 + 1)
end;

{------------------------------------------------------------------------------}

function Bound(x, lw, up: integer): integer;
{------------------------------------------------------------------------------}
{ Returns the closest integer to x bounded between l and u. }
begin
  if (x < lw) then
    Result := lw
  else
    if (x > up) then
      Result := up
    else
      Result := x;
end;

{ PUBLIC FUNCTIONS }
{------------------------------------------------------------------------------}

function LeftStr(s: string; k: integer): string;
{------------------------------------------------------------------------------}
{ Returns len number of characters in the left part of the string s. }
begin
  if (k < 1) or (Length(s) < k) then
    Result := ''
  else
    Result := Copy(s, 1, k);
end;

{------------------------------------------------------------------------------}

function RightStr(s: string; k: integer): string;
{------------------------------------------------------------------------------}
{ Returns k number of characters in the right part of the string s. }
var
  temp: integer;
begin
  temp := Length(s);
  if (k < 1) or (temp < k) then
    Result := ''
  else
    Result := Copy(s, temp - k + 1, k);
end;

{------------------------------------------------------------------------------}

function MidStr(s: string; p, k: integer): string;
{------------------------------------------------------------------------------}
{ Returns k number of characters starting with the p th character. }
var
  ls: integer;
begin
  ls := Length(s);
  p := Bound(p, 1, ls);
  if ((p + k - 1) > ls) or (p < 1) or (k < 0) then
    Result := ''
  else
    Result := Copy(s, p, k);
end;

{------------------------------------------------------------------------------}

function LeftPosStr(s, s1: string; n: integer): integer;
{------------------------------------------------------------------------------}
{ Returns the position of the nth occurence of string s1 in string s counting
  from the left. }
var
  i, j, ls, ls1: integer;
  found: boolean;
begin
  i := 1;
  found := false;
  ls := Length(s);
  ls1 := Length(s1);
  while (i <= ls) and not (found) do
  begin
    if MatchStr(s, s1, i, j, ls, ls1) then
    begin { occurence found ... }
      dec(n);
      if (n = 0) then
        found := true { all occurences found }
      else { skip past end of occurence }
        i := j;
    end
    else
      inc(i);
  end;
  if found then
    Result := i
  else
    Result := 0;
end;

{------------------------------------------------------------------------------}

function RightPosStr(s, s1: string; n: integer): integer;
{------------------------------------------------------------------------------}
{ Returns the position of the nth occurence of string s1 in string s counting
  from the left. }
var
  i, j, ls, ls1: integer;
  found: boolean;
begin
  found := false;
  ls := Length(s);
  ls1 := Length(s1);
  i := ls - ls1 + 2;
  while (i > 1) and not (found) do
  begin
    dec(i);
    if MatchStr(s, s1, i, j, ls, ls1) then
    begin { occurence found ... }
      dec(n);
      if (n = 0) then
        found := true
      else
        i := i - ls1 + 1;
    end;
  end;
  if found then
    Result := i
  else
    Result := 0;
end;

{------------------------------------------------------------------------------}

function StripAllStr(s, s1: string): string;
{------------------------------------------------------------------------------}
{ Strips all occurences of string s1 from s. }
var
  i, j, ls, ls1: integer;
  c: string;
begin
  i := 1;
  ls := Length(s);
  ls1 := Length(s1);
  c := '';
  while (i <= ls) do
  begin
    if MatchStr(s, s1, i, j, ls, ls1) then
      i := j
    else
    begin { no occurence ... }
      c := c + s[i];
      inc(i);
    end;
  end;
  Result := c;
end;

{------------------------------------------------------------------------------}

function StripStr(s, s1: string; n: integer): string;
{------------------------------------------------------------------------------}
{ Strips the nth occurence of s1 from s. }
var
  i, ls, ls1: integer;
  left_s, right_s: string;
begin
  i := LeftPosStr(s, s1, n);
  if i = 0 then
    Result := s
  else
  begin
    if (i = 1) then
      left_s := ''
    else
      left_s := LeftStr(s, i - 1);
    ls := Length(s);
    ls1 := Length(s1);
    if (i - ls1 = ls) then
      right_s := ''
    else
      right_s := RightStr(s, ls - i - ls1);
    Result := left_s + right_s;
  end;
end;

{------------------------------------------------------------------------------}

function TrimLeftStr(s, s1: string; n: integer): string;
{------------------------------------------------------------------------------}
{ Trims at most n occurences (if n is zero then all occurences) of s1 from the
  immediate left of s. }
var
  j, ls, ls1: integer;
  done: boolean;
begin
  done := false;
  ls := Length(s);
  ls1 := Length(s1);
  while not done do
  begin
    j := LeftPosStr(s, s1, 1);
    if (j = 1) then
    begin
      s := RightStr(s, ls - ls1);
      ls := Length(s);
      dec(n);
      done := (n = 0);
    end
    else
      done := true;
  end;
  Result := s;
end;

{------------------------------------------------------------------------------}

function TrimRightStr(s, s1: string; n: integer): string;
{------------------------------------------------------------------------------}
{ Trims at most n occurences (if n is zero then all occurences) of s1 from the
  immediate right of s. }
var
  j, ls, ls1: integer;
  done: boolean;
begin
  done := false;
  ls := Length(s);
  ls1 := Length(s1);
  while not done do
  begin
    j := RightPosStr(s, s1, 1);
    if (j = ls - ls1 + 1) then
    begin
      s := LeftStr(s, ls - ls1);
      ls := Length(s);
      dec(n);
      done := (n = 0);
    end
    else
      done := true;
  end;
  Result := s;
end;

{------------------------------------------------------------------------------}

function PadLeftStr(s, s1: string; k: integer): string;
{------------------------------------------------------------------------------}
{ Pads the string s on the left with the string s1, returning the result to the
  specified length counting from the left (or as near as possible - e.g. it does
  not use substrings of s1 to reach the specified length. For example
  PadLeftStr('345', '12', 6) = '12345', not '112345'. }
var
  ls, ls1: integer;
begin
  ls := Length(s);
  ls1 := Length(s1);
  if k <= ls then
    Result := LeftStr(s, k)
  else
  begin
    while (ls + ls1 <= k) do
    begin
      s := s1 + s;
      ls := ls + ls1;
    end;
    Result := s;
  end;
end;

{------------------------------------------------------------------------------}

function PadRightStr(s, s1: string; k: integer): string;
{------------------------------------------------------------------------------}
{ Pads the string s on the right with the string s1, returning the result to the
  specified length counting from the right(or as near as possible - e.g. it does
  not use substrings of s1 to reach the specified length.) }
var
  ls, ls1: integer;
begin
  ls := Length(s);
  ls1 := Length(s1);
  if k <= ls then
    Result := RightStr(s, k)
  else
  begin
    while (ls + ls1 <= k) do
    begin
      s := s + s1;
      ls := ls + ls1;
    end;
    Result := s;
  end;
end;

{------------------------------------------------------------------------------}

function PadMidStr(s, s1: string; p, k: integer): string;
{------------------------------------------------------------------------------}
{ Pads the string s in the middle at the position p with the string s1,
  returning the result to the specified length counting from the left. (or as
  near as possible - e.g. it does not use substrings of s1 to reach the
  specified length.) }
var
  ls, ls1, t: integer;
  c: string;
begin
  ls := Length(s);
  ls1 := Length(s1);
  if k <= ls then
    Result := LeftStr(s, k)
  else
  begin
    p := Bound(p, 1, ls);
    c := LeftStr(s, p - 1);
    t := ls - p + 1;
    while (ls + ls1 <= k) do
    begin
      c := c + s1;
      ls := ls + ls1;
    end;
    Result := c + RightStr(s, t);
  end;
end;

{------------------------------------------------------------------------------}

function InsertLeftStr(s, s1: string; n: integer): string;
{------------------------------------------------------------------------------}
{ Inserts n copies of the string s1 to the left of s. }
var
  i: integer;
begin
  for i := 1 to n do
    s := s1 + s;
  Result := s;
end;

{------------------------------------------------------------------------------}

function InsertRightStr(s, s1: string; n: integer): string;
{------------------------------------------------------------------------------}
{ Inserts the n copies of the string s1 to the right of s. }