project1.~dpr

电力系统集中抄表 采集器 上位机软件 可以经行集中抄表

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBTables, StdCtrls, ADODB, Grids, DBGrids, Menus, FileCtrl,
  ExtCtrls, StrUtils, shellapi, DbiTypes, DbiProcs, DbiErrs;
function EleOpenComm(iPort: integer; iBaud: integer): integer; stdcall; external 'EleCommDll.dll' name 'EleOpenComm';
function EleCloseComm: integer; stdcall; external 'EleCommDll.dll' name 'EleCloseComm';
function ElePutFile(sPCFileName: PCHAR; sBTFileName: PCHAR; iSerialNo: integer): integer; stdcall; external 'EleCommdll.dll' name 'ElePutFile';
function EleGetFile(sPCFileName: PCHAR; sBTFileName: PCHAR; iSerialNo: integer): integer; stdcall; external 'EleCommdll.dll' name 'EleGetFile';
function EleListFile(iSerialNo: integer): integer; stdcall; external 'EleCommDLL.dll' name 'EleListFile';
function EleDeleteFile(sBTFileName: PCHAR; iSerialNo: integer): integer; stdcall; external 'EleCommDLL.dll' name 'EleDeleteFile';
function EleGetListFileCount(): integer; stdcall; external 'EleCommDLL.dll' name 'EleGetListFileCount';
function EleGetListFileLength(iIndex: integer): integer; stdcall; external 'EleCommDLL.dll' name 'EleGetListFileLength';
function EleGetListFileTime(iIndex: integer): PCHAR; stdcall; external 'EleCommDLL.dll' name 'EleGetListFileTime';
function EleGetListFileName(iIndex: integer): PCHAR; stdcall; external 'EleCommDLL.dll' name 'EleGetListFileName';
function EleSetTime(iYear: integer; iMonth: integer; iDay: integer; iHour: integer; iMinute: integer; iSecond: integer; iSerialNo: integer): integer; stdcall; external 'EleCommDll.dll' name 'EleSetTime';
type
  TForm1 = class(TForm)
    Database1: TDatabase;
    OpenDialog1: TOpenDialog;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    ADOQuery1: TADOQuery;
    Button3: TButton;
    PopupMenu1: TPopupMenu;
    ReadTime: TMenuItem;
    dd21: TMenuItem;
    dd31: TMenuItem;
    FileListBox1: TFileListBox;
    receive: TMemo;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    PopupMenu2: TPopupMenu;
    N11: TMenuItem;
    RadioGroup1: TRadioGroup;
    Shape1: TShape;
    Edit1: TEdit;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    Edit2: TEdit;
    Button1: TButton;
    DBGrid2: TDBGrid;
    rrrr1: TMenuItem;
    ADOQuery2: TADOQuery;
    Database2: TDatabase;
    DataSource2: TDataSource;
    Filedir: TEdit;
    Button2: TButton;
    ExistDBF: TEdit;
    delete: TButton;
    DBFdir: TEdit;
    xiugaijzq: TMenuItem;
    Break: TEdit;
    dbgrid2select: TEdit;
    Shape2: TShape;
    changejzqhao: TEdit;
    N16: TMenuItem;
    ADOQuery3: TADOQuery;
    DataSource3: TDataSource;
    Database3: TDatabase;
    DBGrid3: TDBGrid;
    Label1: TLabel;
    Label2: TLabel;
    ComboBox1: TComboBox;
    PopupMenu3: TPopupMenu;
    N17: TMenuItem;
    DBGrid4: TDBGrid;
    ADOQuery4: TADOQuery;
    Database4: TDatabase;
    DataSource4: TDataSource;
    N19: TMenuItem;
    N20: TMenuItem;
    N18: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    DataSource5: TDataSource;
    N23: TMenuItem;
    N24: TMenuItem;
    N25: TMenuItem;
    N26: TMenuItem;
    N27: TMenuItem;
    N28: TMenuItem;
    N29: TMenuItem;
    N30: TMenuItem;
    N31: TMenuItem;
    N32: TMenuItem;
    N33: TMenuItem;
    Editsort: TEdit;
    Table1: TTable;
    ADOCommand1: TADOCommand;
    n34: TMenuItem;
    Table2: TTable;
    gai1: TMenuItem;
    N35: TMenuItem;
    // procedure Button1Click(Sender: TObject);
    procedure test(Column: TColumn);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ChoseDbf(Sender: TObject);
    procedure FileListBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer);
    // procedure Button2Click(Sender: TObject);
    procedure ReadTimeClick(Sender: TObject);
    procedure dd21Click(Sender: TObject);
    procedure dd31Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure DBGrid2CellClick(Column: TColumn);
    procedure DBGrid2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer);
    procedure rrrr1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure deleteClick(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure xiugaijzqClick(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure DBGrid2KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DBGrid2KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DBGrid2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer);
    procedure N16Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure N19Click(Sender: TObject);
    procedure N23Click(Sender: TObject);
    procedure N20Click(Sender: TObject);
    procedure N24Click(Sender: TObject);
    procedure N25Click(Sender: TObject);
    procedure N28Click(Sender: TObject);
    procedure N27Click(Sender: TObject);
    procedure N29Click(Sender: TObject);
    procedure N30Click(Sender: TObject);
    procedure DBGrid1TitleClick(Column: TColumn);
    procedure n34Click(Sender: TObject);
    procedure gai1Click(Sender: TObject);
    procedure N35Click(Sender: TObject);
    procedure DBGrid2TitleClick(Column: TColumn);




  private
    procedure ShowCommStatus(status: integer);


  public
    procedure Receivedata(datastring: string);
    procedure jzqBHFromDBF();
    procedure PackDbf();
    procedure comcolorRed();
    procedure comcolorGreen();
    procedure DBGrid1EnControl();
    procedure DbgridTitle(DbgridNumber: string;BiaoMing:string);
    function ParseTempString(datastring: string): integer;
    function receive6869613(datastring: string): integer;
    function receive656667(datastring: string): integer;
    function Parse6869TempString(datastring: string): string;
    procedure Delay(dwMilliseconds: Longint);
    function ParseDataOnlyOne(DataLen: integer): integer;
    function jzqBHToTxt(JzqHao: string): string;
    function DelayTest(): integer;
    function comminitialize(): string;
    procedure PopupMenu1false();
    function testrecordcount(s:string):string;
    procedure PopupMenu1true();
    procedure BeforeAddFsjcDbf();
    procedure AddFsjcDbf();
    procedure FJDBGrid2CellClick();
    procedure changejzqBH();
    procedure ClearDbf();
    function TestNewBH(JzqHao: string): string;
   function TestInte(strtointTest: string): string;
    { Public declarations }
  end;

var
  Form1: TForm1;
  hcom: Thandle;
  lpol: Poverlapped;
  OldGridWnd: TWndMethod;
   Testrecount:string;

implementation

uses Unit2, Unit3, Unit5, Unit4, Unit6, Unit7,Unit8;

{$R *.dfm}
procedure TForm1.PopupMenu1false();
var
  i: integer;
begin
  for i := 0 to 17 do
    PopupMenu1.Items[i].Enabled := false;
end;

procedure TForm1.PopupMenu1true();
var
  i: integer;
begin
  for i := 0 to 17 do
    PopupMenu1.Items[i].Enabled := true;
end;
{以下是hex--->dec}
function HexToDec(Str: string): integer;
var
  i, M: integer;
begin
  Result := 0;
  M := 1;
  Str := AnsiUpperCase(Str);
  for i := length(Str) downto 1 do begin
    case Str[i] of
      '1'..'9': Result := Result + (Ord(Str[i]) - Ord('0')) * M;
      'A'..'F': Result := Result + (Ord(Str[i]) - Ord('A') + 10) * M;
    end;
    M := M shl 4;
  end;
end;
{以上是hex--->dec}

procedure TForm1.comcolorRed();
begin
  if IntToStr(RadioGroup1.ItemIndex + 1) = '2' then begin
    Shape2.Brush.Color := clred;
  end
  else begin
    Shape1.Brush.Color := clred;
  end;

end;

procedure TForm1.comcolorGreen();
begin
  if IntToStr(RadioGroup1.ItemIndex + 1) = '2' then begin
    Shape2.Brush.Color := clGreen;
  end
  else begin
    Shape1.Brush.Color := clGreen;
  end;

end;

procedure TForm1.FJDBGrid2CellClick();
var
  ConStr, s: string;
  z1: array[0..254] of char;
  zz, teststr: string;
  F: TextFile;
  Sr: TSearchRec;
  Err: integer;
  TrSize, FilePath: string;
begin




  if DBGrid2.Columns.Count > 0 then begin
    DBGrid2.PopupMenu := PopupMenu1;

    if DBGrid2.SelectedRows.Count > 1 then begin
      BeforeAddFsjcDbf();
      exit;
    end;

    zz := Filedir.Text; //<----程序所在目录

    DBGrid2.SelectedRows.Count; //当前行号
    dbgrid2select.Text := DBGrid2.Fields[0].AsString;


    //获得dbf文件目录
    AssignFile(F, zz + '\directory.txt'); { File selected in dialog box }
    Reset(F);
    Readln(F, s); { Read the first line out of the file }
    DBFdir.Text := s; { Put string in a TEdit control }
    CloseFile(F);
    // 获得dbf文件目录
      //2004-02-13加入类似vb中dir功能
    Err := FindFirst(DBFdir.Text + '*' + DBGrid2.Fields[0].AsString + '.dbf', $37, Sr);
    while Err = 0 do begin
      // ProcessSearchRec(Sr);
      Err := FindNext(Sr);
    end;
    FindClose(Sr);
    // showmessage(sr.Name);
      //2004-02-13加入类似vb中dir功能

    zz := s + Sr.name;
    if Edit1.Text <> zz then begin
      Edit1.Text := zz; //ExtractFilePath(zz); <----当前DBF的目录
      if FileExists(zz) then begin
        ExistDBF.Text := '1'; //<----当前目录下存在所需的DBF文件
        ADOQuery1.Close;
        ConStr := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source="'
          + DBFdir.Text //ExtractFilePath(zz)
        + '";Extended Properties=dBase 5.0;Persist Security Info=False';

        s := ExtractFileName(zz);
        s := copy(s, 1, Pos('.dbf', Lowercase(s)) - 1);
        //ADOQuery1
        ADOQuery1.ConnectionString := ConStr;
        ADOQuery1.SQL.Clear;
        ADOQuery1.SQL.Add('select * from ' + s);
        ADOQuery1.Active := true;
        ADOQuery1.Open;
        DBGrid1.DataSource.DataSet := ADOQuery1;
        DbgridTitle('DBGrid1', s);
        //ADOQuery1
        testrecordcount(s);
        //ADOQuery3
        ADOQuery3.Close;
        ADOQuery3.ConnectionString := ConStr;
        ADOQuery3.SQL.Clear;
        ADOQuery3.SQL.Add('select * from ' + s + ' order by dxh');
        ADOQuery3.Active := true;
        ADOQuery3.Open;
        DBGrid3.DataSource.DataSet := ADOQuery3;
        //DbgridTitle('DBGrid1');
        //ADOQuery3



        DbgridTitle('DBGrid1', s);
      end;

      if not FileExists(zz) then begin
        ExistDBF.Text := '0'; //<----当前目录下不存在所需的DBF文件
        //DBGrid1.DataSource.DataSet.ClearFields;
        ADOQuery1.Close;
        ConStr := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source="'
          + Filedir.Text + '\dbf' //ExtractFilePath(zz)
        + '";Extended Properties=dBase 5.0;Persist Security Info=False';

        ADOQuery1.ConnectionString := ConStr;

        ADOQuery1.SQL.Clear;
        ADOQuery1.SQL.Add('select zhh from Nulltest');
        ADOQuery1.Active := true;
        ADOQuery1.Open;
        DBGrid1.DataSource.DataSet := ADOQuery1;
        DBGrid1.Columns[0].Title.caption := ' ';
      end;
    end;
  end;
end;






function TForm1.DelayTest(): integer;
var
  DelaySecond: integer;
  dwEvtMask, dwError: Dword;
  wait: Boolean;
  cs: Tcomstat;

begin
  wait := false;
  dwEvtMask := 0;
  DelaySecond := 0;
  cs.cbInQue := 0;
  // receive.Text := '';

  while (DelaySecond < 64 * 5) and (cs.cbInQue = 0) do begin
    ClearCommError(hcom, dwError, @cs);
    Delay(25);
    DelaySecond := DelaySecond + 1; //25毫秒后无数据
    if (DelaySecond = 64 * 5) then begin
      receive.Lines.Add('操作失败!');
      Result := 1; //fail
      exit;
    end;
    //加入中断