global.pas

这个程序软件很不错很不错的

unit Global;

interface

uses  Windows, Messages, Dialogs,SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Menus, ActnList, Winsock, Registry, IniFiles, DateUtils,StrUtils,Data,
  AdoDB,DBGrids,ComObj, Base,math;

const
   gs_ScreenWidth:longint=1024;
   gs_ScreenHeight:longint=768;

type
  TfindArray1 = array[0..50] of string;
  TfindArray2 = array[0..50] of string;
  TfindArray3 = array[0..50] of string;

type
   TBaseFormClass = class of TfrmBase;
   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 ;
   procedure p_GetHardDiskState(ss:TStrings);
   function f_ReadMainINI(Section,ValueName:String):String ;
   Procedure p_WriteMainINI(Section,ValueName,ValueString:String);
   function f_Replace(Input,s1,s2:string): string;
   function f_IsFileInUse(fName : string ) : boolean;
   procedure p_ExportToExcel(SourceDataSet:TADOQuery);
   procedure p_Getpels(width,height:longint);
   Function getplogin(checkstr:string;vpass:string;vuser:string;vserver:string):string;
   function getdataserver(oldstring,servername:string):string;
   procedure OpenForm(FormClass: TFormClass; var fm; AOwner:TComponent);
   function getcurrentweek(cdate:Tdatetime):string;
   function yRound(s:real;non:integer):real;
   function vartosql(value: variant): string;
   function Roundfloat(f: double; i: integer): double;
   function syRmb(sourcemoney: real): widestring;
   function createadoconn(Const CurAccD:String):String;
   function gs_ISadoconnect(Const StrConn:String):Boolean;

   procedure initArray();

var
   gs_UserID: integer;
   gs_UserCode, gs_UserName, gs_password: string;
   gs_Admin: Boolean;
   gs_AppPath,gs_AppName,gs_computername,gs_IniFileName:string;
   SystemName: string;
   LockCount:integer;
   AccountName:String;
   iProductID:integer;
   iBillTypeID:integer;

   findArray1:TfindArray1;
   findArray2:TfindArray2;
   findArray3:TfindArray3;

   Searchtiao:string;

implementation

procedure initArray();
begin
  Searchtiao:='';
  fillChar(findArray1,sizeof(findArray1),0);
  fillChar(findArray2,sizeof(findArray2),0);
  fillChar(findArray3,sizeof(findArray3),0);
end;

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]:='星期天';

  AccountName:='';
  gs_AppPath:=f_GetAppPath();
  gs_AppName:=f_GetAppName;
  gs_computername:=f_GetComputerName;
  gs_IniFileName:=Copy(gs_AppName,1,length(gs_AppName)-4)+'.ini';
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;

procedure p_GetHardDiskState(ss:TStrings);
Const DiskName='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
Var
   i,x:Integer;
   RootDriver:String;
   sec1,byt1,cl1,cl2:longword;
begin
   ss.Clear;
   for i:=1 to length(DiskName) do
   begin
      RootDriver:=Copy(DiskName,i,1)+':\';
      x:=GetDriveType(PChar(RootDriver));
      case x of
        2:ss.Append(Copy(DiskName,i,1)+':琌