global.pas

车辆管理系统

unit Global;

interface

uses  Windows, Classes, Graphics, Controls, Forms, AdoDB, DBGrids, ComObj,
      math, Sysutils, WinSock, IniFiles, StrUtils, Variants,Base_C, Messages;

const
  c_Msg = 'MSG';
  c_Connect = 'Connect';
  c_Close = 'Close';
  c_DisConnect = 'Disconnect';
  c_ScreenWidth = 800;
  c_ScreenHeight = 600;
  m_showform = 'ShowForm';
  m_LockColumn = 'LockColumn';
  m_unLockColumn = 'unLockColumn';
  m_Close = 'Close';
  c_Succeed = 'Succeed';
  c_Failed = 'Failed';

type
   TBaseFormClass = class of TfrmBase_C;
   procedure main_ini();
   Function f_PadL(sInput:string;iLen:integer;sFill:string):string;
   Function f_PadR(sInput:string;iLen:integer;sFill:string):string;
   Function f_encrypt(sInput:string):string;
   Function f_inencrypt(sInput:string):string;
   Function Space(len:integer) :string;
   Function FillString(sInput:string;len:integer) :string;
   function f_GetComputerName():String ;
   function f_GetLocalIP : string;
   function f_GetOS():String ;
   function f_GetDisplayMetrics():String ;
   function f_GetLanguage():string;
   function f_GetAppPath:String ;
   function f_GetAppName:String ;
   function f_Replace(Input,s1,s2:string): string;
   function f_IsFileInUse(fName : string ) : boolean;
   procedure OpenForm(FormClass: TFormClass; var fm;AOwner:TComponent);
   function getcurrentweek(cdate:Tdatetime):string;
   function vartosql(value: variant): string;
   function getscreenpoint(sender:Tcontrol):Tpoint;
   procedure f_writeclientini(section,valueName,Valuestring:string);
   procedure sendDataToDLL(handle:Thandle;MSGinfo:String);
   function GetLogDir(RootDir:String):String;

   function csyslog(fform, fevent: WideString): WordBool;
   function srNow():wideString;
   function cexecsql(cmdStr: WideString): WordBool;
   function getapptitle: WideString;
   function CheckAdminLogin(const PassWord: WideString): WordBool;
   function CheckLogin(const Usercode, Password: WideString): Integer;
   function getusername(const Usercode, Password: WideString): WideString;
   function getisadmin(const usercode, password: WideString): WordBool;
   function getUserright(UserID: Integer): OleVariant;     

var
   gs_UserID: integer;
   gs_UserCode, gs_UserName, gs_password: string;
   gs_IsAdmin:boolean;

   gs_getcomputername:string;
   gs_getlocalIP:string;
   gs_getOS:string;
   gs_getdisplaymetrics:string;
   gs_getlanguage:string;
   gs_getAppPath:string;
   gs_getappName:string;
   gs_getApptitle:String;

   LockCount:integer;
   isScoketconnectionopen:boolean;
   SServerIP:string;
   gs_GetAccName:String;
   gs_GetDBName:String;

   DLLformHandle:Thandle;
   RegisterSuccess:Boolean;
   
implementation

uses dm_Client;

procedure main_ini;
begin
  SysLocale.PriLangID:=LANG_CHINESE;
  DateSeparator:='.';
  LongDateFormat:='yyyy.mm.dd';
  ShortDateFormat:='yyyy.mm.dd';

  TimeSeparator:=':';
  LongTimeFormat:='hh:nn:ss';
//  ShortTimeFormat:='';
  TimeAMString:='上午';
  TimePMString:='下午';
  LongDayNames[1]:='星期日';
  LongDayNames[2]:='星期一';
  LongDayNames[3]:='星期二';
  LongDayNames[4]:='星期三';
  LongDayNames[5]:='星期四';
  LongDayNames[6]:='星期五';
  LongDayNames[7]:='星期六';

  SServerIP:='';
  gs_getApptitle:='';

  gs_getcomputername:=f_GetComputerName();
  gs_getlocalIP:=f_GetlocalIP();
  gs_getOS:=f_GetOS();
  gs_getdisplaymetrics:=f_GetDisplayMetrics();
  gs_getlanguage:=f_GetLanguage();
  gs_getAppPath:=f_GetAppPath();
  gs_getappName:=f_GetAppName();
end;

Function f_PadL(sInput:string;iLen:integer;sFill:string):string;
Var
   sAdd,sOutput:String;
   i,InputLen,FillLen,AddLen:integer;
begin
   FillLen:=length(sFill);
   InputLen:=length(sInput);
   AddLen:=iLen - InputLen;
   if AddLen <= 0 Then
      sOutput:=sInput
   else begin
      i:=InputLen+FillLen;
      while i <= iLen do
      begin
         sAdd:=sAdd + sFill;
         i:=i+FillLen;
      end;//for
      sAdd:=sAdd + copy(sFill,1,AddLen mod FillLen);
      sOutput := sAdd+sInput;
   end;//if
   Result:=sOutput;
end;

Function f_PadR(sInput:string;iLen:integer;sFill:string):string;
Var
   sAdd,sOutput:String;
   i,InputLen,FillLen,AddLen:integer;
begin
   FillLen:=length(sFill);
   InputLen:=length(sInput);
   AddLen:=iLen - InputLen;
   if AddLen <= 0 Then
      sOutput:=sInput
   else begin
      i:=InputLen+FillLen;
      while i <= iLen do
      begin
         sAdd:=sAdd + sFill;
         i:=i+FillLen;
      end;//for
      sAdd:=sAdd + copy(sFill,1,AddLen mod FillLen);
      sOutput:=sInput + sAdd;
   end;//if
   Result:=sOutput;
end;

Function f_encrypt(sInput:string):string;
Const
AllChar:string='abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 ';
Var
   sOutput :string;
   iPin:byte;
begin
   if sInput = '' Then
      sOutput := ''
   else
   begin
//      sInput := f_PadR(sInput,20,' ');
      for iPin:=1 to Length(sInput) do
      begin
        sOutput := sOutput+Char(Ord(sInput[iPin]) + 128);
      end;
   end;
   Result := sOutput;
end;

Function f_inencrypt(sInput:string):string;
Const
AllChar:string='abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 ';
Var
   sOutput :string;
   iPin:byte;
begin
   if sInput = '' Then
      sOutput := ''
   else
   begin
  //    sInput := f_PadR(sInput,20,' ');
      for iPin:=1 to Length(sInput) do
      begin
        sOutput := sOutput+Char(Ord(sInput[iPin]) + 128);
      end;
   end;
   Result := Trim(sOutput);
end;

Function Space(len:integer) :string;
Var
i:integer;
   sResult:string;
begin
for i := 1 to len do
   begin
sResult := sResult + ' ';
   end;
   Result := sResult;
end;

Function FillString(sInput:string;len:integer) :string;
Var
i:integer;
   sResult:string;
begin
for i := 1 to len do
   begin
sResult := sResult + sInput;
   end;
   Result := sResult;
end;

function f_GetComputerName():String ;
var
  CNameBuffer : PChar;
  fl_loaded : Boolean;
  CLen : ^DWord;
begin
   GetMem(CNameBuffer,255);
    New(CLen);
    CLen^:= 255;
    fl_loaded := GetComputerName(CNameBuffer,CLen^);
    if fl_loaded then
      Result := StrPas(CNameBuffer)
    else
      Result := 'Unkown';
    FreeMem(CNameBuffer,255);
    Dispose(CLen);
end;

function f_GetLocalIP : 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:=StrPas(inet_ntoa(pptr^[I]^));
    Inc(I);
  end;
  WSACleanup;
end;

function f_GetOS():String ;
var
OS : TOSVersionInfo;
begin
OS.dwOSVersionInfoSize := sizeof(OS);
GetVersionEx(OS);
with OS do
    case dwPlatformId of
        VER_PLATFORM_WIN32s :
              Result := 'Windows 3.1x/32s';
        VER_PLATFORM_WIN32_WINDOWS :
            Begin
                if (dwMajorVersion = 4) and (dwMinorVersion > 0) then
                Result := 'Windows 98'
              else
                Result := 'Windows 95';
            end;
        VER_PLATFORM_WIN32_NT :
                if (dwMajorVersion = 5) then
                  Result := 'Windows 2000';
              else
                Result := 'Windows NT4.0';
      end;
end;

function f_GetDisplayMetrics():String ;
begin
Result:=IntToStr(GetSystemMetrics(SM_CXSCREEN))+'*'+IntToStr(GetSystemMetrics(SM_CYSCREEN))
end;

function f_GetLanguage():string;
var
  ID:LangID;
  Language: array [0..100] of char;
begin
  ID:=GetSystemDefaultLangID;
  VerLanguageName(ID,Language,100);
  Result:=StrPas(Language);
end;

function f_GetAppPath:String ;
Var
   ExePath:String;
   LastBackSlashPos,Index:Integer;
begin
   ExePath:=Application.ExeName;
   for Index := 1 to length(ExePath) do
      if ExePath[Index]='\' then
         LastBackSlashPos:=Index;
   Result:= Copy(ExePath,1,LastBackSlashPos-1);
end;

function f_GetAppName:String ;
Var
   ExePath:String;
   LastBackSlashPos,Index:Integer;
begin
   ExePath:=Application.ExeName;
   for Index := 1 to length(ExePath) do
      if ExePath[Index]='\' then
         LastBackSlashPos:=Index;
   Result:= Copy(ExePath,(LastBackSlashPos+1),(length(ExePath)-LastBackSlashPos));
end;

function f_Replace(Input,s1,s2:string): string;
begin
   Result:='';
   while Pos(s1,Input) > 0 do
   begin
      Result:= Result+LeftStr(Input,pos(s1,Input)-1)+s2;
      Input:=RightStr(Input,length(Input)-Pos(s1,Input)-length(s1)+1);
   end;
   Result:=Result+Input;
end;

function f_IsFileInUse(fName : string ) : boolean;
var
  HFileRes : HFILE;
begin
  Result := false;
  if not FileExists(fName) then
    exit;
  HFileRes := CreateFile(pchar(fName), GENERIC_READ or
GENERIC_WRITE,0, nil, OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL, 0);
  Result := (HFileRes = INVALID_HANDLE_VALUE);
  if not Result then
    CloseHandle(HFileRes);
end;

procedure OpenForm(FormClass: TFormClass; var fm;
AOwner:TComponent);
var
  i: integer;
  Child:TForm;
begin
  Child:=nil;
  for i := 0 to Screen.FormCount -1 do
     if Screen.Forms[i].Classtype=FormClass then
      begin
        Child:=Screen.Forms[i];
        if Child.WindowState=wsMinimized then
           ShowWindow(Child.handle,SW_SHOWNORMAL)
        else
           ShowWindow(Child.handle,SW_SHOWNA);
      if (not Child.Visible) then Child.Visible:=True;
         Child.BringToFront;
         Child.Setfocus;
         TForm(fm):=Child;
         Child:=TForm(FormClass.NewInstance);
         exit;
      end;
  if Child=nil then
  begin
    TForm(fm):=Child;
    Child:=FormClass.Create(Application);
  end;
end;

function getcurrentweek(cdate:Tdatetime):string;
const
sWeek:array[1..7] of string = ('日','一','二','三','四','五','六');
var
cWeek:integer;
begin
  cWeek:=DayofWeek(Cdate);
  Result:=Trim(sWeek[cWeek]);
end;

function vartosql(value: variant): string;
begin
  if varisnull(Value) then
    Result:='NULL'
    else
    case Vartype(value) of
      varDate:
        Result:=Quotedstr(Datetimetostr(VartoDatetime(Value)));
      varString,varOlestr:
        Result:=Quotedstr(Trim(Vartostr(Value)));
      varboolean:
        begin
          if Value then
            Result:='1'
            else
            Result:='0';
        end;
      else
        Result:=Quotedstr(Trim(Vartostr(Value)));
      end;
end;

function getscreenpoint(sender:Tcontrol):Tpoint;
var
  clientpoint:Tpoint;
begin
  clientpoint:=point(0,sender.Height);
  while sender.Parent<>nil do
    begin
      clientpoint:=point(sender.Left+clientpoint.X,sender.Top+clientpoint.Y);
      sender:=Sender.Parent;
    end;
  clientpoint:=sender.ClientToScreen(clientpoint);
  Result:=clientpoint;
end;

procedure f_writeclientini(section,valueName,Valuestring:string);
var
  myinifile:Tinifile;
  myinifileName:string;
begin
  myinifilename:=GetLogDir('Log')+'Login.ini';
  Myinifile:=Tinifile.Create(myinifilename);
  Myinifile.WriteString(section,valueName,ValueString);
  Myinifile.Free;
end;

procedure sendDataToDLL(handle:Thandle;MSGinfo:String);
var
  ds:TCopyDataStruct;
  cMsginfo:String;
begin
  try
    cMsginfo:=Msginfo;
    ds.cbData:=Length(cMsginfo)+1;
    ds.dwData:=0;
    GetMem(ds.lpData,ds.cbData);
    StrCopy(ds.lpData,Pchar(cMsginfo));
    SendMessage(DLLformHandle,WM_COPYDATA,handle,Cardinal(@ds));
  finally
    FreeMem(ds.lpData);
  end;
end;

function GetLogDir(RootDir:String):String;
var
  SAppPath:String;
begin

SAppPath:=ExtractfilePath(Application.ExeName);
  If Copy(SappPath,Length(SappPath),1)='\' then
    Delete(SappPath,length(SappPath),1);
  while (Copy(SappPath,Length(SappPath),1)<>'\') and (Length(SappPath)>0) do
    Delete(SappPath,length(SappPath),1);
  if SappPath<>'' then
    begin
      if not DirectoryExists(SappPath+RootDir+'\') then
        CreateDir(SappPath+RootDir+'\');
      Result:=SappPath+RootDir+'\';
    end
    else
    Result:='c:\';
end;

function csyslog(fform, fevent: WideString): WordBool;
begin
  Result:=dmClient.SocketConnection1.AppServer.syslog(gs_GetDBName,c_Succeed,fform,fevent,gs_UserCode,gs_getcomputername);
end;

function srNow():wideString;
begin
  Result:=dmClient.SocketConnection1.AppServer.GetServerTime;
end;

function cexecsql(cmdStr: WideString): WordBool;
begin
  Result:=dmClient.SocketConnection1.AppServer.execsql(gs_GetDBName,cmdstr)
end;

function getapptitle: WideString;
begin
  Result:=dmClient.SocketConnection1.AppServer.GetappTitle;
end;

function CheckAdminLogin(const PassWord: WideString): WordBool;
begin
  Result:=dmClient.SocketConnection1.AppServer.getAdminLogin(PassWord);
end;

function CheckLogin(const Usercode, Password: WideString): Integer;
begin
  Result:=dmClient.SocketConnection1.AppServer.getLogin(gs_GetDBName,UserCode,Password);
end;

function getusername(const Usercode, Password: WideString): WideString;
begin
  Result:=dmClient.SocketConnection1.AppServer.getusername(gs_GetDBName,UserCode,Password);
end;

function getisadmin(const usercode, password: WideString): WordBool;
begin
  Result:=dmClient.SocketConnection1.AppServer.getadmin(gs_GetDBName,usercode,password);
end;

function getUserright(UserID: Integer): OleVariant;
begin
  Result:=dmClient.SocketConnection1.AppServer.getUserRight(gs_GetDBName,UserID);
end;

end.