undefine.pas

本产品是开发LISTVIEW相关功能的可定制产品

{**********************************************************************
                 一些常用/通用的全局过程和方法
代码名称:   显示及打印定制需要的数据库操作
编译工具：  Delphi 6.0
作者：      邓普德
版权：      成都四方信息技术有限公司
定义时间：  2006-08-02
修改时间：  2006-08-06
**********************************************************************}

unit unDefine;

interface

uses
  Windows, Messages,dbtables, SysUtils, Classes, Graphics,ComCtrls, Controls, Forms, Dialogs,
  Buttons, ExtCtrls,Grids, DBGrids, StdCtrls, Mask, DBCtrls, Db, Spin,CheckLst,
  Calendar, variants,WinSock,DateUtils;

type
  TLVControl = (lvUP,lvDown,lvHome,lvEnd);
  function _getTimeFromStdStr(StdStr: string; var getTime: TDateTime): Boolean;
  procedure ShowColor(Form:TForm);  //
  procedure ShowColorRp(Form:TForm);  //报表专用
  procedure ListViewUPDownControl(ListView : TListView;lvControl : TLVControl);//控制ListView数据的上下移动
  function GetVersion(filename:string):string;
  function getIPs: TStrings;//获取本机IP地址  
  function TestIP(IP: string): Boolean;
  function GetStrSByDivideChar(DivideChar:Char;InputStr : String):TStringList;//由分隔符获得字符集
  procedure clearList(var pList:TList);
  procedure CreateLog;  
  procedure WriteLog(var Memo:Tmemo;Str:String);  
  procedure MaintenanceLogDay;

  //通用的ListView控制
  var
  ColorCase,bPlaySound,bCustomLogin,nWaitNum:integer;
  sUserID:string;//操作人员工号
  CMemo:TMemo;
  FLogName:string;//保存读写日志目录


implementation

procedure ShowColorRp(Form:TForm);  //将显示的数据清除
begin
   ShowColor(Form);
end;

function _getTimeFromStdStr(StdStr: string; var getTime: TDateTime): Boolean;
var
  Y, M, D, H, N, S: Word;
begin
  Result := False;
  try
    Y := StrToInt(Copy(StdStr, 1, 4));
    if Copy(StdStr, 5,1) <> '-' then Exit;

    M := StrToInt(Copy(StdStr, 6, 2));
    if Copy(StdStr, 8,1) <> '-' then Exit;

    D := StrToInt(Copy(StdStr, 9, 2));
    if Copy(StdStr, 11,1) <> ' ' then Exit;

    H := StrToInt(Copy(StdStr, 12, 2));
    if Copy(StdStr, 14,1) <> ':' then Exit;

    N := StrToInt(Copy(StdStr, 15, 2));
    if Copy(StdStr, 17,1) <> ':' then Exit;

    S := StrToInt(Copy(StdStr, 18, 2));

    getTime := EncodeDate(Y, M, D) + EncodeTime(H, N, S, 0);
    Result := True;
  except
    Result := False;
    Exit;
  end;
end;

procedure ShowColor(Form:TForm);  //将显示的数据清除
var i : integer;
    BKColor,FontColor:TColor;
begin
{//转换测试！
  str:='$00E10000';
  i:=strtoint(str);
  FontColor:=TColor(Format('%x', [i]));
  lvReportName.Color:=FontColor;
}
//  FontColor:=$00E10000;//
//  FontColor:=TColor($00E1FFFF);
//  BKColor:=$00D2E1C8;
//  BKColor:=clWhite;
  //TColor($00E4B841);
////Added by dpd 2003-11-10 Begin
//  FontColor:=clBlack;
{0:缺省Windows标准色调
1:黑色前景淡绿色背景
2:黑色前景铁青色背景
3:黑色前景淡蓝色背景
4:黑色前景淡紫色背景
5:米黄色前景铁青色背景
//6:主窗体标准色调报表黑色前景铁青背景
//7:主窗体标准色调报表米黄色前景铁青色背景}
   case ColorCase of
     0:
     begin
       BKColor:=clWhite;
       FontColor:=clBlack;
     end;
     1:
     begin
       BKColor:=$00E6F0E1;
       FontColor:=clBlack;
     end;
     2:
     begin
       BKColor:=$00A08C64;
       FontColor:=clBlack;
     end;
     3:
     begin
       BKColor:=$00FFF0E6;
       FontColor:=clBlack;
     end;
     4:
     begin
       BKColor:=$00FFF0F0;
       FontColor:=clBlack;
     end;
     5:
     begin
       BKColor:=$00A08C64;
       FontColor:=$00C4FFFF;
     end;
     6://ShowDemo($00FFFAF0,clBlack);
     begin
       BKColor:=$00FFFAF0;
       FontColor:=clBlack;
     end;
     7://ShowDemo($00F0F5F0,clBlack);
     begin
       BKColor:=$00F0F5F0;
       FontColor:=clBlack;
     end;

     8://ShowDemo($00F0F5F0,clBlack);
     begin
       BKColor:=$00DBECEC;
       FontColor:=clBlack;
     end;
     9://ShowDemo($00F0F5F0,clBlack);
     begin
       BKColor:=$00FAFFFF;
       FontColor:=clBlack;
     end;
     else
     begin
       BKColor:=clWhite;
       FontColor:=clBlack;
     end;
   end;
//  BKColor:=clWhite;
  //$00E8CAD5;
  for i:= 0 to Form.ComponentCount - 1 do
    if(Form.Components[i].tag <100)then
      begin
        if (Form.Components[i] is TEdit) then
        begin
           (Form.Components[i] as TEdit).Color := BKColor;
           (Form.Components[i] as TEdit).Font.Color := FontColor;
        end;
        if (Form.Components[i] is TMemo) then
        begin
          (Form.Components[i] as TMemo).Color := BKColor;
          (Form.Components[i] as TMemo).Font.Color := FontColor;
        end;
        if (Form.Components[i] is TComboBox) then
          begin
           (Form.Components[i] as TComboBox).Color := BKColor;
           (Form.Components[i] as TComboBox).Font.Color := FontColor;
          end;
        if (Form.Components[i] is TListView) then
          begin
           (Form.Components[i] as TListView).Color := BKColor;
           (Form.Components[i] as TListView).Font.Color := FontColor;
          end;
        if (Form.Components[i] is TSpinEdit) then
          begin
           (Form.Components[i] as TSpinEdit).Color := BKColor;
           (Form.Components[i] as TSpinEdit).Font.Color := FontColor;
          end;
        if (Form.Components[i] is TMemo) then
          begin
           (Form.Components[i] as TMemo).Color := BKColor;
           (Form.Components[i] as TMemo).Font.Color := FontColor;
          end;
{        if (Form.Components[i] is TCheckBox) then
          begin
           (Form.Components[i] as TCheckBox).Color := BKColor;
           (Form.Components[i] as TCheckBox).Font.Color := FontColor;
          end;}
        if (Form.Components[i] is TListBox) then
          begin
           (Form.Components[i] as TListBox).Color := BKColor;
           (Form.Components[i] as TListBox).Font.Color := FontColor;
          end;
{        if (Form.Components[i] is TRadioGroup) then
          begin
           (Form.Components[i] as TRadioGroup).Color := BKColor;
           (Form.Components[i] as TRadioGroup).Font.Color := FontColor;
          end;
        if (Form.Components[i] is TRadioButton) then
          begin
           (Form.Components[i] as TRadioButton).Color := BKColor;
           (Form.Components[i] as TRadioButton).Font.Color := FontColor;
          end;         }
        if (Form.Components[i] is TDBGrid) then
          begin
           (Form.Components[i] as TDBGrid).Color := BKColor;
           (Form.Components[i] as TDBGrid).Font.Color := FontColor;
          end;

        if (Form.Components[i] is TLabeledEdit) then
          begin
           (Form.Components[i] as TLabeledEdit).Color := BKColor;
           (Form.Components[i] as TLabeledEdit).Font.Color := FontColor;
          end;

        if (Form.Components[i] is TTreeView) then
          begin
           (Form.Components[i] as TTreeView).Color := BKColor;
           (Form.Components[i] as TTreeView).Font.Color := FontColor;
          end;
        if (Form.Components[i] is TCheckListBox) then
          begin
           (Form.Components[i] as TCheckListBox).Color := BKColor;
           (Form.Components[i] as TCheckListBox).Font.Color := FontColor;
          end;
        if (Form.Components[i] is TStringGrid) then
          begin
           (Form.Components[i] as TStringGrid).Color := BKColor;
           (Form.Components[i] as TStringGrid).Font.Color := FontColor;
          end;
        if (Form.Components[i] is TDateTimePicker) then
          begin
           (Form.Components[i] as TDateTimePicker).Color := BKColor;
           (Form.Components[i] as TDateTimePicker).Font.Color := FontColor;
          end;
        if (Form.Components[i] is TMonthCalendar) then
          begin
           (Form.Components[i] as TMonthCalendar).CalColors.MonthBackColor := BKColor;
           (Form.Components[i] as TMonthCalendar).CalColors.TextColor := FontColor;
          end;
        if (Form.Components[i] is TCalendar) then 
          begin
           (Form.Components[i] as TCalendar).Color := BKColor;
           (Form.Components[i] as TCalendar).Font.Color := FontColor;
          end;
       end;
end;

//获取本机IP地址
function getIPs: TStrings;
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:=TStringList.Create;
  Result.Clear;
  GetHostName(Buffer,SizeOf(Buffer));
  phe := GetHostByName(buffer);
  if phe = nil then
  begin
    Exit;
  end;
    pPtr := PaPInAddr(phe^.h_addr_list);
    I := 0;
  while pPtr^[I] <> nil do
  begin
    Result.Add(inet_ntoa(pptr^[I]^));
    Inc(I);
  end;
    WSACleanup;
end;

function TestIP(IP: string): Boolean;
var
  Pos: Integer;
  I, ID, Index: Integer;
  Str, tmpStr: string;
begin
  Result := False;
  Str := IP;
  tmpStr := '';
  Index := 0;

  if LowerCase(Str) = 'localhost' then
  begin
    Result := True;
    Exit;
  end;

  for I := 1 to Length(Str) do
  begin
    if Str[I] = '.' then
    begin
      if I = Length(Str) then Exit;
      try
        ID := StrToInt(tmpStr);
        if not (ID in [0..255]) then Exit;
        tmpStr := '';
        Inc(Index);
      except
        Exit;
      end;
    end else
    begin
      tmpStr := tmpStr + Str[I];
      try
        ID := StrToInt(tmpStr);
        if not (IntToStr(ID) = tmpStr) then Exit;
        if not (ID in [0..255]) then Exit;
      except
        Exit;
      end;
    end;
  end;

  if Index = 3 then  Result := True;
end;

//取得版本信息
function GetVersion(filename:string):string;
var
  InfoSize, Wnd: DWORD;
  VerBuf: Pointer;
  szName: array[0..255] of Char;
  Value: Pointer;
  Len: UINT;
  TransString:string;
begin
  InfoSize := GetFileVersionInfoSize(PChar(FileName), Wnd);
  if InfoSize <> 0 then
  begin
    GetMem(VerBuf, InfoSize);
    try
      if GetFileVersionInfo(PChar(FileName), Wnd, InfoSize, VerBuf) then
      begin
        Value :=nil;
        VerQueryValue(VerBuf, '\VarFileInfo\Translation', Value, Len);
        if Value <> nil then
           TransString := IntToHex(MakeLong(HiWord(Longint(Value^)), LoWord(Longint(Value^))), 8);
        Result := '';
        StrPCopy(szName, '\StringFileInfo\'+Transstring+'\FileVersion');
        if VerQueryValue(VerBuf, szName, Value, Len) then
           Result := StrPas(PChar(Value));
      end;
    finally
      FreeMem(VerBuf);
    end;
  end;
end;



procedure ListViewUPDownControl(ListView : TListView;lvControl : TLVControl);//控制ListView数据的上下移动
var
  Oper : Word;
begin
  if ListView.Items.Count = 0 then Exit;
  case lvControl of
    lvUP : Oper := VK_UP;
    lvDown : Oper := VK_DOWN;
    lvHome : Oper := VK_HOME;
    lvEnd : Oper := VK_END;
  end;
  SendMessage(ListView.Handle,WM_KEYDOWN,Oper,0);
  ListView.OnClick(nil);
end;

function GetStrSByDivideChar(DivideChar:Char;InputStr : String):TStringList;//由分隔符获得字符集
var
  S,tmp : String;
  i,J,M : Integer;
begin
  Result := TStringList.Create;
  S := InputStr;
  i := 0;
  J := 0;
  M := 0;
  for i := 0 to Length(S) do
  begin
    if S[i]= DivideChar then
    begin
      M := I-J;
      tmp := copy(S,J+1,M-1);
      J := I;
      Result.Add(tmp);
    end;
  end;
  //取最后一条数据
  if J < Length(S) then
  begin
    tmp := Copy(S,J+1,Length(S)-J);
    Result.Add(tmp);
  end;
end;

procedure clearList(var pList:TList);
var
  I: Integer;
begin
  //将list数组中的内容清空
  i:=pList.Count;
  if i=0 then exit ;
  for i := pList.Count-1  DownTo 0 do
  begin
     Dispose(pList[i]);
     pList.Delete(i);
  end;
  plist.Clear;
  pList.Pack;
end;

//获取可执行文件当前目录，并创建日志目录
procedure CreateLog;
var strCurrentDir:string;
    I:integer;
begin
  strCurrentDir:='';
  strCurrentDir:=extractfilepath(Application.ExeName);//获取可执行文件所在当前目录
  I := Pos('.',ExtractFileName(Application.ExeName))-1;
  FLogName := Copy(ExtractFileName(Application.ExeName),1,I);
  FLogName := strCurrentDir + 'Log\';
  CreateDir('Log');//如果不存在日志目录则创建
end;

//调用写错误日志函数
procedure WriteLog(var Memo:Tmemo;Str:String);
Var
  AFileName:TextFile;
  FileName:String;
Begin
  FileName:=FLogName+FormatDateTime('YYYYMMDD',Date)+'.log';
  AssignFile(AFileName,FileName);
  if Not FileExists(FileName) then ReWrite(AFileName)
  else Append(AFileName);
  Writeln(AFileName,Format('%s   %s',[DateTimeToStr(now),Str]));
  if Memo<>nil then
    if Memo.Lines.Count >= 500 then
    begin
      Memo.Lines.Delete(Memo.Lines.Count-500);
      Memo.Lines.Add(DateTimeToStr(now)+''''+Str);
    end else
      Memo.Lines.Add(DateTimeToStr(now)+''''+Str);
  Flush(AFileName);
  CloseFile(AFileName);
End;

//自动维护，是系统仅保留最近30天的本地日志文件
procedure MaintenanceLogDay;
var
  FileList : TStringList;
  tmpStr,PathName : String;
  ff,I,LogDay : Integer;
  sr : TSearchRec;
  filename : String;
  LogDate : TDate;

  function ConvertStrToDate(Str:String):TDate;
  var
    tmpStr : String;
    LogYear,LogMonth,LogDay:String;
    LogDate : String;
  begin
    LogYear := Copy(Str,0,4);
    LogMonth := Copy(Str,5,2);
    LogDay := Copy(Str,7,2);
    LogDate := LogYear+'-'+LogMonth+'-'+LogDay;
    Result := StrToDate(LogDate);
  end;
begin
  if StrToTime(FormatDateTime('HH:NN',Now()))<>StrToTime('12:30') then Exit;
  FileList := TStringList.Create;
  tmpStr := GetCurrentDir();
  PathName := tmpStr;
  tmpStr := tmpStr+'\Log\*.log';
  try
    ff := FindFirst(tmpStr,faAnyFile,sr);
    if ff <> 0 then
    begin
      FileList := nil;
      Exit;
    end;
    while ff = 0 do
    begin
      FileList.Add(sr.Name);
      ff := FindNext(sr);
    end;
    FindClose(sr);
    LogDay := 30;//暂时仅保留30天//为进行灵活配置可以考虑从数据库中去取
    LogDate := Today()-LogDay;
    for I := 0 to FileList.Count-1 do
    begin
      if LogDate > ConvertStrToDate(FileList[I]) then
      begin
        filename := '';
        filename := PathName + '\Log\'+FileList[I];
        DeleteFile(filename);
      end;
    end;
    FileList.Free;
  except
    Exit;
    FileList.Free;
  end;
end;

end.