ucomm.pas

1. 发卡服务端：Server 项目文件：autojet.prj 2. 计费客户端：Client 项目文件：internet.prj Explorer.prj 先启动Exp

unit UComm;

interface

uses
  Windows,SysUtils,forms,TLHELP32,Registry,ADODB,dialogs;

function padl(s:string;len:integer):string;

function myexecSql(S: string): boolean ;

function waitcom:boolean;

Function CardInfo(var ICtype, ICno: string; var ICmoney: Currency; var ICdate: Tdatetime): integer ;

function ServerDateTime: TDatetime ;

function SetPCSystemTime(tDati: TDateTime): Boolean;

function GetCurrRate: integer ;

Function GetMoney: integer ;

Function ChgTable: integer ;

function SetPrivilege (sPrivilegeName: string; bEnabled: Boolean) : Boolean;  // 关机

function WinExit (iFlags: integer) : Boolean;  // 关机

procedure DisaControl ;  // 禁用功能

procedure EnabControl ;   // 激活功能

function ReadSyspara: string ;

function ChgMoneyTimes(nport:integer;no,info:pchar):integer;
function ChkCard(nport:integer):integer;

VAR
   COMPORT:INTEGER;
   USED:BOOLEAN;

implementation

uses uthread, sys_global, Dlldef, fmain, ShowUser ;


function padl(s:string;len:integer):string;
begin
   result:=TRIM(s);
   while length(result)<len do
      result:='0'+result;
end;
function ChkCard(nport:integer):integer;
var
   i:integer;
begin
   for i:=1 to 3 do begin
      result:=checkcard(nport);
      if result in [0,3] then
         exit;
   end;
end;

function ChgMoneyTimes(nport:integer;no,info:pchar):integer;
var
   i:integer;
begin
   for i:=1 to 3 do begin
      result:=ChgMoney(nport,no,info);
      if result=0 then
         exit;
   end;
end;

function myexecSql(S: string): boolean ;
begin
  result := false ;
  f_main.Qry_tmp1.Close ;
  f_main.Qry_tmp1.SQL.Clear ;
  f_main.Qry_tmp1.SQL.Add(s) ;
  try
    f_main.Qry_tmp1.ExecSQL ;
  except
    exit ;
  end;
  result := true ;
end;

function waitcom:boolean;
var
  t1:dword;
begin
  t1:=gettickcount();
  while USED AND (gettickcount()-t1<=2000) do  // 若COM被人使用,等待二秒
     application.ProcessMessages;
  result:=NOT USED;
end;

// 读卡上的信息
Function CardInfo(var ICtype, ICno: string; var ICmoney: Currency; var ICdate: Tdatetime): integer ;
var
  p: array[0..32] of char;
  ICmoney1, ICdate1: string ;

  i:integer;
begin
  for i:=1 to 3 do begin
     result := getno(m_com,p);
     if result=0 then
        break;
  end;
  if result<>0 then
     exit;
  ICtype := copy(p,1,1) ;
  ICno := copy(p,2,5) ;
  ICmoney1 := copy(p,7,4)+'.'+copy(p,11,2) ;   // 记时卡可以考虑去掉小数点
  ICdate1 := copy(p,13,2)+'-'+copy(p,15,2)+'-'+copy(p,17,2)+' '+copy(p,19,2)+':'+copy(p,21,2);

  try
     if ictype<>'5' then
        ICmoney := strTofloat(ICmoney1);
     ICdate := strTodateTime(ICdate1) ;
  except
     result:=1;
  end;
end;


function  ServerDateTime: TDatetime ;  // 取得服务器的时间, 如2002-05-26 17:23:55
begin
  if m_stop='9' then begin
     result:=now;
     exit;
  end;
  with f_main.Qry_tmp1 do
  begin
    close;
    sql.text := 'select getdate()' ;
    try
      open;
    except
      try
        open;
      except
        m_Stop := '9' ;
        if f_main.mythread<>nil then                    // 9=提示请检查电脑网络
           f_main.mythread.isStop := true ;   // 中止这个线程
        result := now ;
        exit;
      end;
    end;
    Result := fields[0].AsDateTime ;   // 产生当前的时间
    close;
  end;
end;

// 设定系统的时间
function SetPCSystemTime(tDati: TDateTime): Boolean;
var
   tSetDati: TDateTime;
   vDatiBias: Variant;
   tTZI: TTimeZoneInformation;
   tST: TSystemTime;
begin
   GetTimeZoneInformation(tTZI);
   vDatiBias := tTZI.Bias / 1440;
   tSetDati := tDati + vDatiBias;
   with tST do
   begin
     wYear := StrToInt(FormatDateTime('yyyy', tSetDati));
     wMonth := StrToInt(FormatDateTime('mm', tSetDati));
     wDay := StrToInt(FormatDateTime('dd', tSetDati));
     wHour := StrToInt(FormatDateTime('hh', tSetDati));
     wMinute := StrToInt(FormatDateTime('nn', tSetDati));
     wSecond := StrToInt(FormatDateTime('ss', tSetDati));
     wMilliseconds := 0;
   end;
   SetPCSystemTime := SetSystemTime(tST);
end;


function  GetCurrRate: integer ;
var
  CurRate: Currency ;  // 计算费率用的变量
begin
  m_Datetime := ServerDateTime ;   // 得到服务器当前的时间

  m_Date := formatdatetime('yyyy"-"mm"-"dd', m_Datetime) ; // 得到服务器当前的日期
  m_time := formatdatetime('hh":"nn":"ss', m_Datetime) ;
  m_time := copy(m_time,1,5);         // 得到服务器当前的时间

  CurRate := 0 ;
  result:=1;

  with f_main.Qry_tmp1 do
  begin
    close;
    sql.Clear ;
    sql.Text := 'select StartTime, PTK1, Jk1, Yk1  from Grate where Gid ='''+m_RTtype+''' order by StartTime' ;
    try
      open  ;
    except
      try
        open;
      except
        m_Stop:='9';
        exit;
      end;
    end;
    first ;

    if m_time < fieldbyname('StartTime').AsString then begin
       last ;
       if m_ICtype='1' then   // 普通卡
         CurRate := fieldbyname('PTK1').AsCurrency ;
       if m_ICtype='2' then   // 金卡
         CurRate := fieldbyname('JK1').AsCurrency ;
       if m_ICtype='3' then   // 银卡
         CurRate := fieldbyname('YK1').AsCurrency ;
    end;

    while not eof do  begin
      if m_ICtype='1' then
        CurRate := fieldbyname('PTK1').AsCurrency ;
      if m_ICtype='2' then
        CurRate := fieldbyname('JK1').AsCurrency ;
      if m_ICtype='3' then
        CurRate := fieldbyname('YK1').AsCurrency ;
      next ;
      if m_time < fieldbyname('StartTime').AsString  then Break ;
    end;
    m_Rate := CurRate ;  //  产生当前的费率
  end;
  result := 0 ;
end;


Function GetMoney: integer ;  // 计算, 当前上机m_montime微秒 所需要的钱
var
  strTmp: string ;
  iPos: word ;
begin
  result:=1;

  if  (m_ICtype='1') or (m_ICtype='2') or (m_ICtype='3') then  // 普通,金,银
  begin
    if GetCurrRate<>0 then  exit;

    m_ICmoney := m_ICmoney - m_Rate ;   // 新的剩余金额
  end;

  if  m_ICtype='5' then  // 规定会员卡上的金额为0
    m_ICmoney := 0;

  if (m_ICtype='4') then  // 计时卡
  begin
    m_Datetime := ServerDateTime ;     // 得到服务器当前的时间
    m_Date := formatdatetime('yyyy"-"mm"-"dd', m_Datetime) ; // 得到服务器当前的日期
    m_time := formatdatetime('hh":"nn":"ss', m_Datetime) ;
    m_time := copy(m_time,1,5);         // 得到服务器当前的时间
    m_ICmoney := m_ICmoney - (m_montime div 60000) ;  // 新的剩余时间
  end;

  if m_ICmoney <0 then m_ICmoney := 0 ;


  str(m_ICmoney:6:2,strTmp);


  strTmp := trim(strTmp) ;
  iPos := pos('.',strTmp) ;
  delete(strTmp,iPos,1);
  m_TimesMoney := padl(strTmp,6);  // 生成了将要写到卡上的剩余金额

  result := 0 ;
end;


Function ChgTable: integer ;    // 将卡上的数据备份
begin
 result := 1 ;
   with f_main.adoquery1    //对消费明细进行剩余金额处理
        do
        begin
        close;
        sql.Clear ;
        sql.add('update addxfmx');
        sql.add('set xfmxsyje=:a1');
        sql.add('where xfmxrq01=:rq01');
        Parameters.parambyname('a1').value := m_icmoney ;
        Parameters.parambyname('rq01').value :=wqhdate  ;


          execsql;
        end;

  with f_main.Qry_tmp1 do
  begin
    close;
    sql.Clear ;
    sql.add('update Card');
    sql.add('set Ldatetime=:Ldatetime,');
    sql.add('SYSJ=:SYSJ, SYJE=:SYJE');
    sql.add('where ICno=:ICno');
    Parameters.parambyname('Ldatetime').value := m_DateTime ;
    Parameters.parambyname('ICno').value := strToint(m_ICno) ;
    if m_ICtype='4'
        then
         begin                              // 若为计时卡
         Parameters.parambyname('SYSJ').value := m_ICmoney ;  // 剩余时间
         Parameters.parambyname('SYJE').value := 0 ;
         end
        else
         begin
         Parameters.parambyname('SYSJ').value := 0 ;
         Parameters.parambyname('SYJE').value := m_ICmoney ;  // 剩余金额
         end;


    try
      execsql;

     except
      try
        execsql;
      except
        m_Stop := '9' ;  // 9=提示请检查电脑网络
        exit ;
      end;
    end;
    result := 0 ;
  end;
end;

function SetPrivilege (sPrivilegeName: string; bEnabled: Boolean) : Boolean;
var
  TPPrev,
  TP       : TTokenPrivileges;
  Token    : THandle;
  dwRetLen : DWORD;
begin
  result := False;

  OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, Token);

  TP.PrivilegeCount := 1;
  if LookupPrivilegeValue(nil, PChar (sPrivilegeName), TP.Privileges[0].LUID) then
  begin
    if bEnabled then
      TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
    else
      TP.Privileges[0].Attributes := 0;

    dwRetLen := 0;
    result := AdjustTokenPrivileges(Token, False, TP, SizeOf (TPPrev), TPPrev, dwRetLen) ;
  end;
  CloseHandle (Token)
end;


function WinExit (iFlags: integer) : Boolean;
begin
  result := true;

  if m_VerId = 1 then begin  // 如果是WINDOW98 则关机
     ExitWindowsEx(EWX_FORCE or EWX_SHUTDOWN,0);
     exit ;
  end;

  if SetPrivilege ('SeShutdownPrivilege', true) then
  begin
    if (not ExitWindowsEx(iFlags, 0)) then  //  对WINDOW NT 关机
    begin
      result := False
    end;
    SetPrivilege ('SeShutdownPrivilege', False)
  end
  else
  begin
    result := False
  end
end;

procedure DisaControl ;
var
  RegTmp: TRegistry ;
  str: string ;
  str1, str2: string ;
begin
  str := ExtractFilePath(application.ExeName);
  if str[length(str)] <> '\' then str := str + '\' ;
  str1 := str+'Explorer.exe';    // 引导程序
  str2 := str+'Internet.exe' ;   // 计费程序

  RegTmp := TRegistry.Create ;
  with RegTmp do
  begin
    RootKey := HKEY_LOCAL_MACHINE ;
    OpenKey('\SoftWare\Microsoft\WindowS\CurrentVersion\RunServices',true);
    WriteString('AcpiBIOS', str1);  // 自动启动引导程序
    CloseKey ;

    OpenKey('\SoftWare\Microsoft\WindowS\CurrentVersion\Run',true);
    WriteString('Acpi', str2);  // 自动启动计费程序
    CloseKey ;

    OpenKey('\SoftWare\Microsoft\WindowS\CurrentVersion\Network\Real Mode Net',true);
//WQH      WriteInteger('AutoLogon',0);          // 自动登录

    WriteInteger('AutoLogon',1);          // 自动登录
    closekey ;

    RootKey := HKEY_CURRENT_USER ;
    OpenKey('\SoftWare\Microsoft\WindowS\CurrentVersion\Policies\System',true);
    WriteInteger('DisableRegistryTools',1);   // 禁止使用注册表编辑器器
    closeKey ;

    OpenKey('\SoftWare\Microsoft\WindowS\CurrentVersion\Policies\Explorer',true);
    WriteInteger('NoRun',0);               // 激活运行菜单
//BjCat    WriteInteger('NoRun',1);               // 激活运行菜单
    closeKey ;

//    OpenKey('\SoftWare\Microsoft\WindowS\CurrentVersion\Policies\WinOldApp',true);
//    WriteInteger('Disabled',1);         // 禁止dos方式
//    WriteInteger('NoRealMode',1);       // 禁止重启电脑并切换到dos方式
//    closeKey ;

    RootKey := HKEY_CLASSES_ROOT ;
    OpenKey('\CLSID\{21EC2020-3AEA-1069-A2DD-08002B30309D}\InProcServer32',true);
    writestring('','shell32.dll-');  //控制面板屏蔽

    CloseKey ;
  end;
  RegTmp.Free ;
end;


procedure EnabControl ;
var
  RegTmp: TRegistry ;
begin
  RegTmp := TRegistry.Create ;

  with RegTmp do
  begin
    RootKey := HKEY_CURRENT_USER ;
    OpenKey('\SoftWare\Microsoft\WindowS\CurrentVersion\Policies\Explorer',true);
    WriteInteger('NoRun',0);               // 激活运行菜单
    WriteInteger('NoDeskTop',0);           // 激活桌面
    CloseKey ;


    OpenKey('\SoftWare\Microsoft\WindowS\CurrentVersion\Policies\System',true);
    WriteInteger('NoDispCPL',0);                 // 激活活动面板的显示属性
    RegTmp.DeleteValue('DisableRegistryTools');  // 激活注册表编辑器器
    closeKey ;
 {
    OpenKey('\SoftWare\Microsoft\WindowS\CurrentVersion\Policies\WinOldApp',true);
    WriteInteger('Disabled',0);         // 激活dos方式
    WriteInteger('NoRealMode',0);       // 激活重启电脑并切换到dos方式
    closeKey ;
}
    RootKey := HKEY_CLASSES_ROOT ;
    OpenKey('\CLSID\{21EC2020-3AEA-1069-A2DD-08002B30309D}\InProcServer32',true);
    writestring('','shell32.dll');
    CloseKey ;
  end;
  RegTmp.Free ;
end;

// 网络连接不通时，得到系统标识
function ReadSyspara: string ;
var
  RegTmp1: TRegistry ;
begin
  RegTmp1 := TRegistry.Create ;
  with RegTmp1 do
  begin
    RootKey := HKEY_LOCAL_MACHINE ;
    OpenKey('\Software\Adel\syspara',true);
    result := readString('SYSID');
    CloseKey ;
  end;
  RegTmp1.Free ;
end;

end.