⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 okc21mainut.~pas

📁 某省公路收费站违章车辆抓拍管理系统
💻 ~PAS
📖 第 1 页 / 共 5 页
字号:
function okSetConvertParam(hBoard: HWND; wParam: word; lParam: Longint):
  Longint; external 'okapi32.dll';
function okWaitSignalEvent(hBoard: HWND; dlwParam: wParam; lMilliSecond:
  lParam): Longint; external 'okapi32.dll';
function okCaptureSingle(hBoard: HWND; Dest: Integer; Lstart: Longint): boolean;
  external 'okapi32.dll';
function okTransferRect(hBoard: HWND; Dest: Integer; iFirst: Longint; src:
  Integer; iStart: Longint; lNum: Longint): Longint; external 'okapi32.dll';
function okConvertRect(hBoard: HWND; Dest: Integer; iFirst: Longint; src:
  Integer; iStart: Longint; lNum: Longint): Longint; external 'okapi32.dll';
function SHFormatDrive(HANDLE: HWND; drive, ID, Options: word): Longint; external
'c:\winnt\system32\shell32.dll' name 'SHFormatDrive'

//==============================================================================


procedure TimerCallProc(TimerID: UINT; msg: UINT;
  dwUser: Dword; dwa: Dword; dwb: Dword); stdcall;
var
  iLan: Integer;
begin
  if CapQue.Count > 0 then begin
    pCapNum := CapQue.Pop;
    iLan := pCapNum^;
    Dispose(pCapNum);

    if iLan > 6 then Exit;

    okc21CapFm.CaptureIt(iLan);
  end;
end;

procedure StartMM;
var
  TC: TIMECAPS;
begin
  if (TimeGetDevCaps(@TC, sizeof(TIMECAPS)) = Timerr_NoError) then begin
    TimerRes := 5;
    if (TimeBeginPeriod(TimerRes) = Timerr_NoError) then begin
      TimerID := TimeSetEvent(350, TimerRes, Addr(TimerCallProc), 0, Time_Periodic);
    end;
  end;
end;


procedure EndMM;
begin
  TimeKillEvent(TimerID);
  TimeEndPeriod(TimerRes);
end;


procedure Tokc21CapFm.Capture(i: Integer);
begin
  //如此道为禁拍车道,跳过
  if i in NoCapLane then Exit;

  New(pCapNum);
  pCapNum^ := i;
  CapQue.Push(pCapNum);
end;

procedure Tokc21CapFm.DelayIt(c: Integer);
var
  i: Integer;
  start: Dword;
begin
  start := GetTickCount;
  start := start + c;
  while GetTickCount < start do begin
    Application.ProcessMessages;
  end;
end;
//
//调用磁盘管理程序,扫描开机后插入的Scsi硬盘
//

procedure Tokc21CapFm.ScanScsi;
begin
  //执行磁盘管理程序
  winexec('mmc.exe "c:\winnt\system32\diskmgmt.msc"', 0);
  DelayIt(1000);
  //模拟Alt+A
  keybd_event(VK_MENU, MapVirtualKey(VK_MENU, 0), 0, 0);
  keybd_event(Ord('A'), MapVirtualKey(Ord('A'), 0), 0, 0);
  keybd_event(Ord('A'), MapVirtualKey(Ord('A'), 0), KEYEVENTF_KEYUP, 0);
  keybd_event(VK_MENU, MapVirtualKey(VK_MENU, 0), KEYEVENTF_KEYUP, 0);
  //模拟R键
  keybd_event(Ord('R'), MapVirtualKey(Ord('R'), 0), 0, 0);
  keybd_event(Ord('R'), MapVirtualKey(Ord('R'), 0), KEYEVENTF_KEYUP, 0);
  //等待扫描所有磁盘完成,模拟Alt+F4退出磁盘管理程序
  DelayIt(50000);
  keybd_event(VK_MENU, MapVirtualKey(VK_MENU, 0), 0, 0);
  keybd_event(VK_F4, MapVirtualKey(VK_F4, 0), 0, 0);
  keybd_event(VK_F4, MapVirtualKey(VK_F4, 0), KEYEVENTF_KEYUP, 0);
  keybd_event(VK_MENU, MapVirtualKey(VK_MENU, 0), KEYEVENTF_KEYUP, 0);
end;

//
//初始化接收控制相关变量,更改屏幕分辨率
//

procedure Tokc21CapFm.Initial;
var
  i: Integer;
  lpDevMode: TDevicemode;
begin
  Rep[0] := 0;
  for i := 1 to 6 do begin
    ReceiveFlag[i] := 0;
    ListenFlag[i] := 0;
    Rep[i] := 0;
    //上条指令初始化为'B',表示上次进行了一次正常的收费操做
    LastCmd[i] := 'B';
  end;

  //改变显示模式为800X600
  if EnumDisplaySettings(nil, 0, lpDevMode) then begin
    if lpDevMode.dmPelsWidth <> 800 then begin
      lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
      lpDevMode.dmPelsWidth := 800;
      lpDevMode.dmPelsHeight := 600;
      ChangeDisplaySettings(lpDevMode, 0);
    end;
  end;

  LeftB := 188;
  RightB := 188;

  CapQue := TQueue.Create;
end;

//
//接收本车道数据完成,通知DATA_MESSAGE消息处理函数作出处理
//
procedure RecvRout1(var ncbR: PNCB); stdcall; far;
begin
  PostMessage(okc21CapFm.HANDLE, DATA_MESSAGE, 1, 0);
end;

procedure RecvRout2(var ncbR: PNCB); stdcall; far;
begin
  PostMessage(okc21CapFm.HANDLE, DATA_MESSAGE, 2, 0);
end;

procedure RecvRout3(var ncbR: PNCB); stdcall; far;
begin
  PostMessage(okc21CapFm.HANDLE, DATA_MESSAGE, 3, 0);
end;

procedure RecvRout4(var ncbR: PNCB); stdcall; far;
begin
  PostMessage(okc21CapFm.HANDLE, DATA_MESSAGE, 4, 0);
end;

procedure RecvRout5(var ncbR: PNCB); stdcall; far;
begin
  PostMessage(okc21CapFm.HANDLE, DATA_MESSAGE, 5, 0);
end;

procedure RecvRout6(var ncbR: PNCB); stdcall; far;
begin
  PostMessage(okc21CapFm.HANDLE, DATA_MESSAGE, 6, 0);
end;

//
//ListenFlag = 2表示此车道已经建立了连接,为1表示正在监听,为0表示未监听、未连接
//
procedure ListenRout1(var ncbR: PNCB); stdcall; far;
begin
  ListenFlag[1] := 2;
end;

procedure ListenRout2(var ncbR: PNCB); stdcall; far;
begin
  ListenFlag[2] := 2;
end;

procedure ListenRout3(var ncbR: PNCB); stdcall; far;
begin
  ListenFlag[3] := 2;
end;

procedure ListenRout4(var ncbR: PNCB); stdcall; far;
begin
  ListenFlag[4] := 2;
end;

procedure ListenRout5(var ncbR: PNCB); stdcall; far;
begin
  ListenFlag[5] := 2;
end;

procedure ListenRout6(var ncbR: PNCB); stdcall; far;
begin
  ListenFlag[6] := 2;
end;

//==============================================================================

//
//初始化NetBIOS 控制块
//

function Tokc21CapFm.Ncb_Reset: boolean;
begin
  result := true;
  try
    //这个命令对指定的L A N A编号进行重新设置,并对某些环境资源产生影响。
    //■ 如果ncb_lsn不是0,与ncb_lana_num相关的所有资源都会被释放。
    //■ 如果ncb_lsn是0,与ncb_lana_num相关的所有资源都会被释放,并分配新的资源。
    //ncb_callname[0]字节指定会话最多能够有多少,
    //ncb_callname[2]字节指定名字最多有多少,ncb_callname[3]则要求应用程序使用计
    //算机名(其名编号为1)
    lana_num := 0;
    CtlNcb.ncb_lana_num := lana_num;
    CtlNcb.ncb_command := NCBRESET;
    CtlNcb.ncb_lsn := 0;
    CtlNcb.ncb_callname[0] := #255;
    CtlNcb.ncb_callname[2] := #255;
    Netbios(Addr(CtlNcb));
    //先初始化LANA0
    if CtlNcb.ncb_retcode = NRC_GOODRET then
      StatusBar1.Panels[1].Text := '0网络初始化成功'
    else begin
      StatusBar1.Panels[1].Text := '0网络初始化失败:' + ' ' +
        inttostr(CtlNcb.ncb_cmd_cplt);

      //初始化LANA0失败,尝试初始化LANA1
      lana_num := 1;
      CtlNcb.ncb_lana_num := lana_num;
      CtlNcb.ncb_command := NCBRESET;
      CtlNcb.ncb_lsn := 0;
      CtlNcb.ncb_callname[0] := #250;
      CtlNcb.ncb_callname[2] := #250;
      Netbios(Addr(CtlNcb));

      if CtlNcb.ncb_retcode = NRC_GOODRET then
        StatusBar1.Panels[1].Text := '1网络初始化成功'
      else begin
        StatusBar1.Panels[1].Text := '1网络初始化失败:' + ' ' +
          inttostr(CtlNcb.ncb_cmd_cplt);
        result := false;
      end;
    end;
  except
    result := false;
  end;
end;

//
//硬盘格式化
//

function Tokc21CapFm.HdFormat(drive: char): boolean;
var
  i: byte;
  retCode: Longint;
begin
  firstRun := true;

  FmtTimer.Enabled := true;

  i := Ord(upcase(drive)) - 65;
  StatusBar1.Panels[7].Text := '格式化' + upcase(drive) + '盘!';
  if i = 2 then begin
    StatusBar1.Panels[7].Text := '不能格式化C盘!';
    result := false;
    Exit;
  end;

  retCode := SHFormatDrive(HANDLE, i, SHFMT_ID_DEFAULT, SHFMT_OPT_QUICKFORMAT);

  if retCode < 0 then begin
    result := false;
    StatusBar1.Panels[7].Text := drive + '盘格式化失败!';
  end
  else
    result := true;

  FmtTimer.Enabled := false;
end;

//
//从服务器对时,并根据服务器更新本地的费率表和收费员表
//

function Tokc21CapFm.updatefromServer: boolean;
var
  NewTime: TsystemTime;
  VarTime: TDateTime;
  hour, min, sec, msec: word;
begin
  result := true;
  try
    DatabaseServer.Open;
    Commqry.close;
    Commqry.sql.clear;
    Commqry.sql.add('select getdate()');
    Commqry.Open;
    VarTime := Commqry['Column1'];
    getlocaltime(NewTime);
    decodetime(VarTime, hour, min, sec, msec);
    decodedate(VarTime, AYear, AMonth, ADay);
    with NewTime do begin
      wyear := AYear;
      wmonth := AMonth;
      wday := ADay;
      whour := hour;
      wMinute := min;
      wSecond := sec;
      wMilliseconds := msec + 50;
    end;
    setlocaltime(NewTime);
  except
    result := false;
    StatusBar1.Panels[7].Text := '连接服务器出错';
  end;

  StatTollor := TollorTab.Active;
  try
    TollorTab.Active := false;
    ServerTab.Active := false;
    ServerTab.TableName := 'Dbo.SC';
    ServerTab.Active := true;
    BatchMove.Source := ServerTab;
    BatchMove.Destination := TollorTab;
    BatchMove.Execute;
    TollorTab.Active := StatTollor;
  except
    TollorTab.Active := StatTollor;
    DatabaseServer.close;
    StatusBar1.Panels[7].Text := '收费员表更新出错!';
    result := false;
  end;

  StatFee := FeeTab.Active;
  DatabaseServer.Open;
  try
    FeeTab.Active := false;
    ServerTab.Active := false;
    ServerTab.TableName := 'Dbo.VF';
    ServerTab.Active := true;
    BatchMove.Source := ServerTab;
    BatchMove.Destination := FeeTab;
    BatchMove.Execute;
    FeeTab.Active := StatFee;
  except
    FeeTab.Active := StatFee;
    DatabaseServer.close;
    StatusBar1.Panels[7].Text := '费率表更新出错!';
    result := false;
  end;
  ServerTab.Active := false;
  DatabaseServer.close;
end;

//
//查找盘,并写上配置文件
//

procedure Tokc21CapFm.IniFileReset;
var
  i, j, n, SortSize, skip: byte;
  inorder: boolean;
  space, FreeSpace: Int64;
  logicDisk: array[1..6] of char;
  Diskspace: array[1..6] of word;
  temstr: string;
  station, CurrentDB: string;
begin
  n := 0;
  // 从C盘开始查找,直到Z盘
  for i := 3 to 26 do begin
    space := DiskSize(i) div Gb;
    FreeSpace := DiskFree(i);
    //无此盘或者无自由空间,跳过
    if (space <= 1) or (FreeSpace = 0) then
      continue;
    //此盘下如无mark.ini文件,就创建一个
    if not FileExists(Chr(64 + i) + ':\mark.ini') then begin
      Myini := TIniFile.Create(Chr(64 + i) + ':\mark.ini');
      //如果是C盘,写进去额外的参数
      if i = 3 then begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -