unit uMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Mask, RzEdit, RzButton, ExtCtrls, IniFiles,
RzTabs, ComCtrls, RzListVw, RzShellCtrls, ImgList, RzShellDialogs,
RzCmboBx, QRCtrls, QuickRpt, jpeg, ShlObj, RzPanel, RzSplit, RzTreeVw,
DB, ADODB, Provider, DBClient, GridsEh, DBGridEh, RzStatus;
type
PShellItem = ^TShellItem;
TShellItem = record
FullID,
ID: PItemIDList;
Empty: Boolean;
DisplayName,
TypeName: string;
ImageIndex,
Size,
Attributes: Integer;
ModDate: string;
end;
TfrmMain = class(TForm)
RzPageControl1: TRzPageControl;
TabSheet1: TRzTabSheet;
TabSheet2: TRzTabSheet;
lbl1: TLabel;
edt_Path1: TRzEdit;
btn_o2: TButton;
Button1: TButton;
SplPreview: TRzSplitter;
img1: TImage;
RzToolbar1: TRzToolbar;
RzSpacer1: TRzSpacer;
ClientDS_PicCap: TClientDataSet;
DataSP_PicCap: TDataSetProvider;
Qry_PicCap: TADOQuery;
Ds_PicCap: TDataSource;
DBGridEh1: TDBGridEh;
ClientDataSetH: TClientDataSet;
DataSetProviderH: TDataSetProvider;
QueryH: TADOQuery;
DataSourceH: TDataSource;
RzBtn_0: TRzBitBtn;
RzBtn_1: TRzBitBtn;
ImageList1: TImageList;
Memo1: TMemo;
ClientDS_PicCapacc_id_only: TStringField;
ClientDS_PicCapname: TStringField;
ClientDS_PicCapplate_num: TStringField;
ClientDS_PicCapplate_type: TStringField;
ClientDS_PicCapInsDate: TDateTimeField;
ClientDS_PicCapAcc_ID_Only_1: TStringField;
ClientDS_PicCapfDateTime: TDateTimeField;
ClientDS_PicCapPicturePath1: TStringField;
ClientDS_PicCapPicturePath2: TStringField;
ClientDS_PicCapPicturePath3: TStringField;
ClientDS_PicCapPicturePath4: TStringField;
ClientDS_PicCapPicturePath5: TStringField;
ClientDS_PicCapPicturePath6: TStringField;
ClientDS_PicCapPicturePath7: TStringField;
ClientDS_PicCapPrintCount: TIntegerField;
ClientDataSetHAutoID: TAutoIncField;
ClientDataSetHfPictureName: TStringField;
ClientDataSetHfCarNum: TStringField;
ClientDataSetHfPicturePath: TStringField;
ClientDataSetHAcc_ID_Only: TStringField;
TabSheet3: TRzTabSheet;
sbrMain: TRzStatusBar;
RzClockStatus1: TRzClockStatus;
RzResourceStatus1: TRzResourceStatus;
stsSection: TRzGlyphStatus;
RzStatusPane1: TRzStatusPane;
RzStatusPane2: TRzStatusPane;
procedure btn_o2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure DBGridEh1Columns2UpdateData(Sender: TObject;
var Text: String; var Value: Variant; var UseText, Handled: Boolean);
procedure ClientDataSetHAfterScroll(DataSet: TDataSet);
procedure RzButton1Click(Sender: TObject);
procedure RzBtn_0Click(Sender: TObject);
procedure RzBtn_1Click(Sender: TObject);
private
{ Private declarations }
procedure pListFilePic; //列出jpg图片
procedure pSendFilePic; //发送图片
procedure pDeletetblTempPicAndCarNum; //删除临时表
procedure RealIniFile; //读INI文件
procedure WriteIniFile; //写INI文件
function CreateFourDir(var aLocatPath, aFortune: string; const ExtFileName: string):boolean; //建接相对路径,返回路径
procedure AddCarNumPickList;
function QueryData(Query1: TADOQuery; SqlStr: string; ExecType: Integer):Boolean; //ExecType =1 打开,
function fUpdatePicturePath(Const aAcc_ID_Only, aPicturePath: String): boolean; //保存DVR1图片路径
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
zzSourceDir: string;
zzScanningPath: String; //扫描路径
implementation
{$R *.dfm}
uses uDM, ShellAPI, FileCtrl;
procedure TfrmMain.btn_o2Click(Sender: TObject);
begin
//ShellExecute(Handle,'open','Explorer.exe',PChar(edt_Path1.Text),nil,1);
end;
procedure TfrmMain.RealIniFile;
var
IniFile: Tinifile;
mStr: string;
i: integer;
begin
mStr := zzSourceDir;
mStr:= mStr + '\Confing.ini';
IniFile:= Tinifile.Create(mStr);
mStr:= IniFile.ReadString('ItemCode', 'Path1', '');
edt_Path1.Text := mStr;
end;
procedure TfrmMain.WriteIniFile;
var
IniFile: Tinifile;
mStr: string;
i: integer;
begin
mStr := ExtractFilePath(paramstr(0));
mStr:= mStr + 'Confing.ini';
IniFile:= Tinifile.Create(mStr);
IniFile.WriteString('ItemCode ', 'Path1', edt_Path1.Text);
end;
procedure TfrmMain.Button1Click(Sender: TObject);
begin
WriteIniFile;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
zzSourceDir:= ExtractFilePath(Application.ExeName);
end;
procedure TfrmMain.AddCarNumPickList;
var
Q: TADOQuery;
mlen: integer;
begin
try
Q := TADOQuery.Create(Self);
Q.Connection := DM.Connect_PicCap;
DBGridEh1.FieldColumns['fCarNum'].PickList.Clear;
if QueryData(Q, 'SELECT * FROM tblMotorphoto a INNER JOIN tblMotorPhotoMaster b ON a.acc_id_only = b.acc_id_only WHERE (b.PicturePath7 IS NULL) order by b.acc_id_only desc ', 1) then
if Q.RecordCount >= 1 then
while not Q.Eof do
begin
//如粤JA838A 只显示 A838A
mlen := Length(Q.FieldByName('plate_num').AsString);
if mlen = 8 then
DBGridEh1.FieldColumns['fCarNum'].PickList.Add(Copy(Trim(Q.FieldByName('plate_num').AsString),4,mlen - 3)) //为了使用查找方便
else
DBGridEh1.FieldColumns['fCarNum'].PickList.Add(Trim(Q.FieldByName('plate_num').AsString)); //为了使用查找方便
Q.Next;
end;
finally
Q.Free;
end;
end;
function TfrmMain.QueryData(Query1: TADOQuery; SqlStr: string;
ExecType: Integer): Boolean;
begin
Result:= True;
with Query1, Query1.Sql do
begin
Close;
Clear;
Add(SqlStr);
try
if ExecType = 1 then
Open
else
ExecSql;
except
Result:= False;
end;
end;
end;
procedure TfrmMain.FormShow(Sender: TObject);
begin
ClientDataSetH.Active := True;
ClientDS_PicCap.Active := True;
AddCarNumPickList;
pDeletetblTempPicAndCarNum;
RealIniFile;
pListFilePic;
end;
procedure TfrmMain.DBGridEh1Columns2UpdateData(Sender: TObject;
var Text: String; var Value: Variant; var UseText, Handled: Boolean);
begin
if Length(Text) = 5 then
begin
//如粤JA838A 只显示 A838A
if ClientDS_PicCap.Locate('plate_num','粤J'+Text,[]) then //为了使用查找方便
ClientDataSetH.FieldByName('acc_id_only').AsString:=ClientDS_PicCap.FieldByName('acc_id_only').AsString;
end
else
begin
if ClientDS_PicCap.Locate('plate_num',Text,[]) then //为了使用查找方便
ClientDataSetH.FieldByName('acc_id_only').AsString:=ClientDS_PicCap.FieldByName('acc_id_only').AsString;
end;
end;
procedure TfrmMain.pSendFilePic;
var
zCompleteCreateDir: boolean;
zLocatPath, zFortune, ExtFileName, m_edt_Path1 :string;
begin
if FileExists(ClientDataSetH.FieldByName('fPicturePath').AsString) then
ExtFileName := ChangeFileExt(ExtractFileName(ClientDataSetH.FieldByName('acc_id_only').asString),''); //去掉后缀名
zCompleteCreateDir := CreateFourDir(zLocatPath, zFortune, ExtFileName);
ClientDataSetH.ApplyUpdates(1);
ClientDataSetH.First;
while not ClientDataSetH.Eof do
begin
if FileExists(ClientDataSetH.FieldByName('fPicturePath').AsString) then //文件是否存在
begin
if ClientDataSetH.FieldByName('fCarNum').AsString <> EmptyStr then //是否选择了车牌
begin
ExtFileName:= ClientDataSetH.FieldByName('acc_id_only').asString;
//本地复制
if CopyFile(PChar(ClientDataSetH.FieldByName('fPicturePath').asString), PChar(zzSourceDir + 'PhotoBakup\'+ zLocatPath +'\' + ClientDataSetH.FieldByName('acc_id_only').asString +'_017.jpg'), False) then //存在同名文件也复制
begin
end;
//文件复制
if CopyFile(PChar(ClientDataSetH.FieldByName('fPicturePath').asString), PChar(edt_Path1.Text + zLocatPath +'\' + ClientDataSetH.FieldByName('acc_id_only').asString +'_017.jpg'), False) then //存在同名文件也复制
begin
if fUpdatePicturePath(ClientDataSetH.FieldByName('acc_id_only').AsString,
zLocatPath +'\' + ClientDataSetH.FieldByName('acc_id_only').asString +'_017.jpg') then
begin
DeleteFile(ClientDataSetH.FieldByName('fPicturePath').asString);
ClientDataSetH.Delete;
end
else
ClientDataSetH.Next;
end
else
begin
ShowMessage(ClientDataSetH.FieldByName('fCarNum').asString + '发送失败!');
ClientDataSetH.Next;
end;
end
else
begin
ShowMessage(ClientDataSetH.FieldByName('fPictureName').asString + '图片未选择对应车牌号!');
ClientDataSetH.Next;
end;
end
else
begin
ShowMessage(ClientDataSetH.FieldByName('fPicturePath').asString + '文件不存在!');
end;
//ClientDataSetH.Next;
end;
end;
function TfrmMain.CreateFourDir(var aLocatPath, aFortune: string;
const ExtFileName: string): boolean;
var
zs1, zs2: string;
begin
Result:= True;
zs1 := Copy(ExtFileName,11,8); //文件名序号年月日
zs2 := Copy(ExtFileName,19,4); //文件名序号后四位
aLocatPath := zs1 + '\' + zs2; //目标目录
if not DirectoryExists(edt_Path1.Text + aLocatPath) then //如果目录不存在(不合法文件)
if not ForceDirectories(edt_Path1.Text + aLocatPath) then
Result:= False;
aLocatPath := zs1 + '\' + zs2; //本地目录
if not DirectoryExists(zzSourceDir +'PhotoBakup\' + aLocatPath) then //如果目录不存在(不合法文件)
if not ForceDirectories(zzSourceDir +'PhotoBakup\' + aLocatPath) then
Result:= False;
end;
function TfrmMain.fUpdatePicturePath(Const aAcc_ID_Only, aPicturePath: String): boolean;
var
Q: TADOQuery;
begin
try
Q := TADOQuery.Create(Self);
Q.Connection := DM.Connect_PicCap;
if QueryData(Q, 'UPDATE tblMotorPhotoMaster SET PicturePath7 = ' + QuotedStr(aPicturePath) +
' WHERE Acc_ID_Only = ' + QuotedStr(aAcc_ID_Only), 0) then
Result := True;
finally
Q.Free;
end;
end;
procedure TfrmMain.pDeletetblTempPicAndCarNum;
var
Q: TADOQuery;
begin
ClientDataSetH.First;
while not ClientDataSetH.Eof do
begin
ClientDataSetH.Delete;
end;
ClientDataSetH.ApplyUpdates(1);
end;
procedure TfrmMain.ClientDataSetHAfterScroll(DataSet: TDataSet);
begin
if ClientDataSetH.Active then
begin
if FileExists(ClientDataSetH.FieldByName('fPicturePath').AsString) then
begin
img1.Picture.LoadFromFile(ClientDataSetH.FieldByName('fPicturePath').AsString);
RzStatusPane1.Caption := ClientDataSetH.FieldByName('fPicturePath').AsString;
RzStatusPane2.Caption := ClientDataSetH.FieldByName('acc_id_only').AsString;
end
else
begin
img1.Hint:= EmptyStr;
img1.Picture := nil;
end;
end;
end;
procedure TfrmMain.pListFilePic;
var
sr: TSearchRec;
begin
if FindFirst(zzSourceDir+'*.jpg', faAnyFile, sr) = 0 then
begin
repeat
if pos('.jpg',lowercase(sr.Name))>0 then
if not ClientDataSetH.Locate('fPictureName',sr.Name,[]) then
begin
ClientDataSetH.Append;
ClientDataSetH.FieldByName('fPictureName').AsString:= sr.Name;
ClientDataSetH.FieldByName('fPicturePath').AsString:= ExpandFileName(sr.Name);
end;
until FindNext(sr) <> 0;
FindClose(sr);
end
else
begin
img1.Picture:= nil;
img1.Hint := EmptyStr;
end;
end;
procedure TfrmMain.RzButton1Click(Sender: TObject);
begin
pListFilePic;
end;
procedure TfrmMain.RzBtn_0Click(Sender: TObject);
begin
pDeletetblTempPicAndCarNum; //删除临时表
pListFilePic;
AddCarNumPickList;
end;
procedure TfrmMain.RzBtn_1Click(Sender: TObject);
begin
pSendFilePic;
end;
end.
图片发送程序.rar （22个子文件） 
PicSendprj.res 876B
PicSendprj.exe 2MB
neng272016-10-10刚好用上，看看合不合适。
