readtxt.pas

感应IC卡电脑考勤、门禁、售饭一卡通管理系统是基于我公司开发生产的ESW型智能卡记录器所具有的对持卡人刷卡卡号、时间、次数进行读取贮存等功能

unit ReadTxt;

interface

uses ReadTxtV,
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Db, Buttons, Mask, DBCtrls, ComCtrls,
  CheckLst, FileCtrl, ADODB, ADOQry;

type
  TfrmReadTxt = class(TForm)
    FileListBox1: TFileListBox;
    Label1: TLabel;
    qrySysSet: TADOQry;
    cmdRead: TBitBtn;
    cmdCancel: TBitBtn;
    qrySysSetKqTxtDir: TStringField;
    qrySysSetKqTxtBakDir: TStringField;
    qrySysSetKqTxtFormat: TStringField;
    ProgressBar1: TProgressBar;
    qryAppend: TADOQry;
    qryKqSrc: TADOQry;
    qryKqSrcLastID: TIntegerField;
    qryUpdEmpID: TADOQry;
    qryUpdMach: TADOQry;
    Label2: TLabel;
    DBEdit1: TDBEdit;
    DataSource1: TDataSource;
    Label3: TLabel;
    DBEdit2: TDBEdit;
    Label4: TLabel;
    DBEdit3: TDBEdit;
    procedure FormCreate(Sender: TObject);
    procedure cmdReadClick(Sender: TObject);
  private
    { Private declarations }
    dlgReadTxtV :TfrmReadTxtV;
    sTxtDir,sTxtBakDir :string;
	nMach0,nMachLen,nCard0,nCardLen,nYear0,nYearLen,nMonth0,nDay0,nHour0,nMin0 :integer;
    function ReadData(sFileName:string) :Boolean;
  public
    { Public declarations }
  end;

var
  frmReadTxt: TfrmReadTxt;

implementation

uses SelfFunc, Kq_Mach;

{$R *.DFM}

function TfrmReadTxt.ReadData(sFileName:string) :Boolean;
	procedure AppendLine(tsLine :string);
    var tsCardNo :string;
	    tFDateTime :TDateTime;
    begin
      {if Pos('17*0752*20339', tsLine) >0 then
     	showmessage('<'+tsLine+'>');
      }
        try
	        tsCardNo :=Copy(tsLine,nCard0,nCardLen);
        	if nYearLen =2 then
        		tFDateTime :=EncodeDate(2000+ StrToInt(Copy(tsLine,nYear0,2))
                		,StrToInt(Copy(tsLine,nMonth0,2))
                		,StrToInt(Copy(tsLine,nDay0,2)) )
                    +EncodeTime(StrToInt(Copy(tsLine,nHour0,2))
                		,StrToInt(Copy(tsLine,nMin0,2))
                        ,0,0)
            else
        		tFDateTime :=EncodeDate(StrToInt(Copy(tsLine,nYear0,4))
                		,StrToInt(Copy(tsLine,nMonth0,2))
                		,StrToInt(Copy(tsLine,nDay0,2)) )
                    +EncodeTime(StrToInt(Copy(tsLine,nHour0,2))
                		,StrToInt(Copy(tsLine,nMin0,2))
                        ,0,0);

            with qryAppend do
            begin
            	Parameters[0].Value :=tFDateTime;
            	Parameters[1].Value :=tsCardNo;
            	Parameters[2].Value :=Copy(tsLine,nMach0,nMachLen);
            	ExecSQL;
            end;
        except
        end;
    end;

var hFile,hFileMap :integer;
	tsLine,tsLine0 :string;
    nSize,i :integer;
    pBuffer :PChar;
begin
    ProgressBar1.Position :=0;
    Result :=False;

    //弄ゅン
	hFile :=CreateFile(PChar(sFileName), GENERIC_READ,
		FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
    if hFile=0 then Exit;

	nSize := GetFileSize(hFile,nil);
    if nSize =0 then
    begin
	    CloseHandle(hFile);
        Result :=True;
    	Exit;
    end;
    tsLine :='ZtHrMapping' +IntToStr(GetTickCount());
	hFileMap := CreateFileMapping(hFile, nil, PAGE_READONLY, 0, 0, PChar(tsLine));
    if hFileMap=0 then
    begin
	    CloseHandle(hFile);
    	Exit;
    end;
	pBuffer := MapViewOfFile(hFileMap, FILE_MAP_READ, 0, 0, 0);
    if pBuffer=nil then
    begin
    	CloseHandle(hFileMap);
	    CloseHandle(hFile);
    	Exit;
    end;

    //糶计誹
    qryAppend.Prepare;
    ProgressBar1.Max :=nSize +100;
    ProgressBar1.Position :=100;

    tsLine0 :='';
   	tsLine :='';
    for i :=0 to nSize-1 do
    begin
    	if pBuffer[i] in [#0, #10, #13] then
        begin
        	if i >0 then
            if not (pBuffer[i-1] in [#0, #10, #13]) then
            begin
	          if tsLine =tsLine0 then tsLine :=''
              else begin
	            tsLine0 :=tsLine;
                tsLine :='';
            	AppendLine(tsLine0);

                ProgressBar1.Position :=100 +i;
              end;
            end;
        end
        else tsLine :=tsLine +pBuffer[i];
    end;
    if tsLine <>'' then AppendLine(tsLine);

    UnmapViewOfFile(pBuffer);
    CloseHandle(hFileMap);
    CloseHandle(hFile);
    Result :=True;
end;

procedure TfrmReadTxt.FormCreate(Sender: TObject);
var i :integer;
begin
	qrySysSet.Open;
    sTxtBakDir :=qrySysSetKqTxtBakDir.Value;
    if not DirectoryExists(sTxtBakDir) then
    begin
    	MsgBox('ゅン称