unit_common.pas

航空人身保险信息管理系统使用SQL和DELHPI开发

    end else begin
      Result := ch1 = ch2;
    end; //if
  end;
begin
  l1 := Length(S1);
  l2 := Length(S2);
  if (l1 <= 0) or (l2 <= 0) then begin Result := 0; Exit; end;
  // Test Length and swap, if S1 is smaller
  if l1 < l2 then begin
    hstr := S2; S2 := S1; S1 := hstr;
    l := l2; l2 := l1; l1 := l;
  end;
  p1 := 1; p2 := 1; hit := 0;
  // calc the unsharp factor depending on
  // the length of the strings
  diff := Max(l1, l2) div 3 + ABS(l1 - l2);
  // init the test array
  test := Classes.TBits.Create;
  // Calc size of TBits. Must be two bigger, because we're 0-Based
  // counting from 1, and we need one more then stringlength
  test.Size := l1 + 2;
  // loop through the string
  repeat
    // position tested?
    if not test.Bits[p1] then begin
      // found a matching character?
      if CompChar(S1[p1], S2[p2]) and
        (ABS(p1 - p2) <= diff) then begin
        test.Bits[p1] := True;
        Inc(hit); // increment the hit count
        // next positions
        Inc(p1); Inc(p2);
        if p1 > l1 then p1 := 1;
      end else begin
        // Set test array
        test.Bits[p1] := False;
        Inc(p1);
        // Loop back to next test position
        if p1 > l1 then begin
          while (p1 > 1) and not (test[p1]) do Dec(p1);
          Inc(p2)
        end;
      end;
    end else begin
      Inc(p1);
      //Loop back to next test position
      if p1 > l1 then begin
        repeat Dec(p1); until (p1 = 1) or test.Bits[p1];
        Inc(p2);
      end;
    end;
  until p2 > l2;
  test.Free; //Release Booleanlist
  //calc procentual value
  Result := 100 * hit div l1;
end;

function Seps(AsArg: Char): Boolean;
begin
  Seps := AsArg in
    [#0..#$1F, ' ', '.', ',', '?', ':', ';', '(', ')', '/', '\'];
end;

function WordCount(CText: string): Longint;
var
  Ix, Count: Word;
  WorkCount: LongInt;
begin
  WorkCount := 0;
  Ix := 1; Count := Length(CText);
  while Ix <= Count do
  begin
    while (Ix <= Count) and Seps(CText[Ix]) do
      Inc(Ix);
    if Ix <= Count then
    begin
      Inc(WorkCount);
      while (Ix <= Count) and (not Seps(CText[Ix])) do
        Inc(Ix);
    end; //if
  end; //if
  Result := WorkCount;
end;

procedure SearchFile(PathName, FindName: string; FList: TStrings; IncludeSubDerectory: Boolean = True);

  procedure ListFile(Path: string);
  var
    Sr: TSearchRec;
    FileCnt: Integer;
  begin
    if IncludeSubDerectory then
    begin
      FileCnt := FindFirst(Path + '\*', faDirectory, Sr);
      while FileCnt = 0 do
      begin
        if ((Sr.Attr and faDirectory) = Sr.Attr) and
          (Sr.Name[1] <> '.') then
          ListFile(Path + '\' + Sr.Name);
        FileCnt := FindNext(Sr);
      end; //if
      FindClose(Sr);
    end; //if

    //faArchive
    FileCnt := FindFirst(Path + '\' + FindName, faAnyFile - faDirectory, Sr);
    while FileCnt = 0 do
    begin
      if (Sr.Attr and (faAnyFile - faDirectory)) = Sr.Attr then
        FList.Add(Path + '\' + Sr.Name);
      FileCnt := FindNext(Sr);
    end; //if
    FindClose(Sr);
  end;
begin
  FList.Clear;
  FList.BeginUpdate;
  try
    ListFile(PathName);
  finally
    Flist.EndUpdate;
  end; //try
end;

//199909----1999年9月

function ShortYearMonthToLongYearMonth(const ShortYearMonth: string): string;
var
  tmStr: string;
  wYear, wMonth: Integer;
begin
  Result := '';
  if ShortYearMonth = '' then Exit;
  tmStr := Copy(ShortYearMonth, 1, 4);
  wYear := StrToInt(tmStr);
  tmStr := Copy(ShortYearMonth, 5, 2);
  wMonth := StrToInt(tmStr);
  Result := Format('%d年%d月', [wYear, wMonth]);
end;

function GetLastYearMonth(const ShortYearMonth: string): string;
var
  tmStr: string;
  wYear, wMonth: Integer;
begin
  Result := '';
  if ShortYearMonth = '' then Exit;
  tmStr := Copy(ShortYearMonth, 1, 4);
  wYear := StrToInt(tmStr);
  tmStr := Copy(ShortYearMonth, 5, 2);
  wMonth := StrToInt(tmStr);
  if wMonth > 1 then
    Dec(wMonth)
  else
  begin
    wMonth := 12;
    Dec(wYear);
  end; //if
  Result := IntToStrEx(wYear, 4) + IntToStrEx(wMonth, 2);
end;

function GetNextYearMonth(const ShortYearMonth: string): string;
var
  tmStr: string;
  wYear, wMonth: Integer;
begin
  Result := '';
  if ShortYearMonth = '' then Exit;
  tmStr := Copy(ShortYearMonth, 1, 4);
  wYear := StrToInt(tmStr);
  tmStr := Copy(ShortYearMonth, 5, 2);
  wMonth := StrToInt(tmStr);
  if wMonth < 12 then
    Inc(wMonth)
  else
  begin
    wMonth := 1;
    Inc(wYear);
  end; //if
  Result := IntToStrEx(wYear, 4) + IntToStrEx(wMonth, 2);
end;

const
  DaysInMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

function DaysOfMonth(const AYear, AMonth: Integer): Integer; overload;
begin
  Result := DaysInMonth[AMonth];
  if (AMonth = 2) and IsLeapYear(AYear) then Inc(Result); { leap-year Feb is special }
end;

function DaysOfMonth(const ShortYearMonth: string): Integer; overload;
var
  tmStr: string;
  wYear, wMonth: Integer;
begin
  tmStr := Copy(ShortYearMonth, 1, 4);
  wYear := StrToInt(tmStr);
  tmStr := Copy(ShortYearMonth, 5, 2);
  wMonth := StrToInt(tmStr);
  Result := DaysOfMonth(wYear, wMonth);
end;

function DaysOfMonth(const ADate: TDate): Integer; overload;
var
  wYear, wMonth, wDay: WORD;
begin
  DeCodeDate(ADate, wYear, wMonth, wDay);
  Result := DaysOfMonth(wYear, wMonth);
end;

{2003-1-8 ---LHQ--}

function GetChineseYMD(Value: TDateTime): string; {得到当指定年的中文年月日 如 返回"2002年12月12日"}
begin
  Result := FormatDateTime('YYYY"年"MM"月"DD"日"', Value);
end;

{2003-1-8 ---LHQ---}

function GetThisExeFileVersion: string; {得到这个EXE文件的当前版本号}
var VerInfoSize, VerValueSize, Dummy: DWORD; VerInfo: Pointer;
  VerValue: PVSFixedFileInfo; V1, V2, V3, V4: word;
begin
  VerInfoSize := GetFileVersionInfoSize(Pchar(ParamStr(0)), Dummy);
  GetMem(VerInfo, VerInfoSize);
  GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo);
  VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
  with VerValue^ do
  begin
    V1 := dwFileVersionMS shr 16;
    V2 := dwFileVersionMS and $FFFF;
    V3 := dwFileVersionLS shr 16;
    V4 := dwFileVersionLS and $FFFF;
  end;
  FreeMem(VerInfo, VerInfoSize);
  Result := intToStr(V1) + '.' + IntToStr(V2) + '.' + IntToStr(V3) + '.' + IntToStr(V4);
end;

{2003-01-09 20:38  ---LHQ--- 得到一个汉字字符串的第一个汉字发音的大写字每}

function GetPYIndexChar(hzchar: string): char;
begin
  case WORD(hzchar[1]) shl 8 + WORD(hzchar[2]) of
    $B0A1..$B0C4: result := 'A';
    $B0C5..$B2C0: result := 'B';
    $B2C1..$B4ED: result := 'C';
    $B4EE..$B6E9: result := 'D';
    $B6EA..$B7A1: result := 'E';
    $B7A2..$B8C0: result := 'F';
    $B8C1..$B9FD: result := 'G';
    $B9FE..$BBF6: result := 'H';
    $BBF7..$BFA5: result := 'J';
    $BFA6..$C0AB: result := 'K';
    $C0AC..$C2E7: result := 'L';
    $C2E8..$C4C2: result := 'M';
    $C4C3..$C5B5: result := 'N';
    $C5B6..$C5BD: result := 'O';
    $C5BE..$C6D9: result := 'P';
    $C6DA..$C8BA: result := 'Q';
    $C8BB..$C8F5: result := 'R';
    $C8F6..$CBF9: result := 'S';
    $CBFA..$CDD9: result := 'T';
    $CDDA..$CEF3: result := 'W';
    $CEF4..$D1B8: result := 'X';
    $D1B9..$D4D0: result := 'Y';
    $D4D1..$D7F9: result := 'Z';
  else
    result := char(32);
  end;
end;

function OnlyInt(Value: char): char; {2003-03-19 22:29  ---LHQ---只能输入数字,增加了可以按回退删除字符}
begin
  Result := Value;
  if not (Result in ['1'..'5', '.',#8, #10, #13]) then Result := #0;
end;

function RunOutExe(ExeFileName: string): integer;
var bCreateProcess: boolean;
  lpStartupInfo: TStartupInfo;
  lpProcessInformation: TProcessInformation;
begin
  FillChar(lpStartupInfo, Sizeof(TStartupInfo), #0);
  lpStartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  lpStartupInfo.wShowWindow := SW_HIDE;
  bCreateProcess := CreateProcessA(nil, PChar(ExeFileName),
    nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil,
    lpStartupInfo, lpProcessInformation);
  if bCreateProcess then
    WaitForSingleObject(lpProcessInformation.hProcess, INFINITE);
  Result := 0;
end;

function BetWeenMonth(StartTime: TDateTime; EndTime: TDateTime): integer;
begin
  result := abs((YearOf(EndTime) - YearOf(StartTime)) * 12 + (MonthOf(EndTime) - MonthOf(StartTime)));
end;

function GetFirstTime(Value: TDate): TDateTime; overload; {得到指定日期的最旱时间}
begin
  Result := StrToDateTime(FormatDateTime('YYYY-MM-DD 00:00:01', Value));
end;


function NodeID0To_(NodeID: string): string; {把0替换成＿ 2003-01-16 16:52  ---LHQ---}
begin
  Result := AnsiReplaceStr(NodeID, '0', '_');
end;

function IntOfFloat(InputValue: real): integer;
begin
  Result := Floor(InputValue);
end;

function FloatOfFloat(InputValue: real): real;
begin
  Result := InputValue - IntOfFloat(InputValue);
end;


function DateToString(InputValue: TDateTime): string; overload;
begin
  Result := FormatDateTime('YYYY-MM-DD HH:MM:SS', InputValue);
end;

function MyString(InputValue: string;Leng:integer): string;
var xx:integer;
   allk:string;
begin
allk:='                              ';
xx:=length(trim(InputValue));
result:=copy(allk,1,leng-xx)+trim(inputValue);

end;

function DateToString(InputValue: string): string; overload;
begin
  Result := copy(InputValue, 1, 4) + '-' +
    copy(InputValue, 5, 2) + '-' +
    copy(InputValue, 7, 2) + ' ' +
    '00:00:01';
end;

function GetLastDayOfMonth(InputValue: TDateTime): TDateTime; overload;
begin
  Result := EndOfTheMonth(InputValue);
end;

function GetLastDayOfMonth(InputValue: string): TDateTime; overload;
begin
  Result := EndOfTheMonth(StrToDate(InputValue));
end;

function GetPYString(hzString: string): string; { 输入一个中文或英文字符串，返回这个字符串的声母字符串 2203-01-23 12:32}
var i: integer; tmpstr: string;
begin
  i := 1;
  tmpstr := trim(hzString);
  result := '';
  if tmpstr <> '' then
    while i < length(tmpstr) + 1 do
    begin if (ord(tmpstr[i]) < 123) and (ord(tmpstr[i]) > 47) then begin result := result + tmpstr[i]; inc(i) end else
      begin
        result := result + GetPYIndexChar(tmpstr[i] + tmpstr[i + 1]);
        i := i + 2;
      end;
    end;
end;

function LengNumber(InputValue: integer; Leng: Integer): string;
var all0: string;
  tmpint: Integer;
begin
  all0 := '0000000';
  tmpint := length(IntToStr(InputValue));
  Result := copy(all0, 1, leng - tmpint) + IntToStr(InputValue);
end;

function CardNoinc(InputValue: string; CardCount: integer): string;
begin
  Result := LengNumber(StrToInt(InputValue) + CardCount, 7);
end;

function YYYYMMDDDate(InputValue: Tdate): string;
begin
   Result:=FormatDateTime('YYYYMMDD',InputValue);
end;

function YYYY_MM_DDDate(InputValue: Tdate): string;
begin
   Result:=FormatDateTime('YYYY-MM-DD',InputValue);
end;
end.