ffrmfiletransfer.pas

代码齐全

	end;
end;

procedure TfrmFileTransfer.ftp1PacketRecvd(Sender: TObject);
begin
	 stxtRcv.Caption :=IntToStr(ftp1.BytesRecvd);
	 prgTransfer.Progress :=ftp1.BytesRecvd;
end;

procedure TfrmFileTransfer.ftp1PacketSent(Sender: TObject);
begin
     stxtRcv.Caption :=IntToStr(ftp1.BytesSent);
     prgTransfer.Progress :=ftp1.BytesSent;
end;

procedure TfrmFileTransfer.sbtnSaveClick(Sender: TObject);
begin
     if dlgSave.Execute then edtDownDestinationFile.Text:=dlgSave.FileName;
end;

procedure TfrmFileTransfer.sbtnOpenClick(Sender: TObject);
begin
	 if dlgOpen.Execute then edtUpSourseFile.Text:=dlgOpen.FileName;
end;

procedure TfrmFileTransfer.FormCreate(Sender: TObject);
var
   reg:TRegistry;
   AppDir:String;
begin
  inherited ;
//     FTPSet.RootKey:=HKEY_CURRENT_USER;
   //set init date
//   PageControl1.ActivePageIndex := 5;
   reg:=TRegistry.Create;
   if reg.OpenKey('\FTPFileTransfer',False) then
   begin
		if reg.ReadString('SaveHost')='1' then
		begin
			chkSaveHost.Checked :=True;
			edtHost.Text:=reg.ReadString('Host');
			edtPort.Text:=reg.ReadString('Port');
		end;
		if reg.ReadString('SaveUser')='1' then
		begin
			chkSaveUser.Checked :=True;
			edtUserID.Text:=reg.ReadString('User');
			edtPassword.Text:=reg.ReadString('Pwd');
		end;
		if reg.ReadString('SaveDownload')='1' then
		begin
			chkSaveDownload.Checked :=True;
			edtDownSourseFile.Text:=reg.ReadString('DownSourseFile');
			edtDownDestinationFile.Text:=reg.ReadString('DownDestinationFile');
		end;
		if reg.ReadString('SaveUpload')='1' then
		begin
			chkSaveUpload.Checked :=True;
			edtUpSourseFile.Text:=reg.ReadString('UpSourseFile');
			edtUpDestinationFile.Text:=reg.ReadString('UpDestinationFile');
		end;
		if reg.ReadString('AutoReceive')='1' then
		begin
			chkAutoReceive.Checked :=True;
			Timer1.Enabled :=True;
		end;

    if reg.ReadString('AutoSend')='1' then
		begin
			chkAutoSend.Checked :=True;
			Timer2.Enabled :=True;
		end;

		Overwrite:=False;
		if reg.ReadString('Overwrite')='1' then
		begin
			chkOverwrite.Checked :=true;
			Overwrite:=True;
		end;
		SendDelete:=False;
		if reg.ReadString('SendDelete')='1' then
		begin
			chkSendDelete.Checked :=true;
			SendDelete:=True;
		end;
		edtReceivePath.Text:=Reg.ReadString('ReceivePath');
		reg.CloseKey;
   end;
   AppDir:=ExtractFileDir(Application.ExeName);
   if not DirectoryExists(AppDir+'\Log') then
		if not CreateDir(AppDir+'\Log') then
			raise Exception.Create('建立目录错误！目录:'+ AppDir+'\Log');
   if not DirectoryExists(AppDir+'\Send') then
		if not CreateDir(AppDir+'\Send') then
			raise Exception.Create('建立目录错误！目录:'+ AppDir+'\Send');
   if not DirectoryExists(AppDir+'\Receive') then
		if not CreateDir(AppDir+'\Receive') then
			raise Exception.Create('建立目录错误！目录:'+ AppDir+'\Receive');
//   if not fileexists(Appdir+'\CSCollection.ini') then MessageBox(handle,'文件不存在！','提示窗口',MB_ICONINFORMATION);

	LoadSendTables;
end;

procedure TfrmFileTransfer.N1Click(Sender: TObject);
begin
	 memLog.Lines.Clear ;
end;

procedure TfrmFileTransfer.btnCollectionClick(Sender: TObject);
var
	AppDir,tblname,tblex,tblfields,FName:String;
	FreePrintIni:TIniFile;
	i:Integer;
  Size:LongInt;
begin
	AppDir:=ExtractFileDir(Application.ExeName);

	if not fileexists(AppDir+'\CSCollection.ini') then
	begin
		MessageBox(Handle,'未发现数据汇总设置文件(CSCollection.ini) !','提示信息',MB_ICONINFORMATION);
		exit;
	end;
	FreePrintIni := TIniFile.Create(AppDir+'\CSCollection.ini');

	for i:=0 to clstSendTable.Items.Count -1 do
	begin
        if not clstSendTable.Checked[i] then continue;
		tblname:=clstSendTable.Items[i];
		tblex:=FreePrintIni.ReadString(clstSendTable.Items[i],'扩展名','.csd');
		tblfields:=FreePrintIni.ReadString(clstSendTable.Items[i],'字段列表','.csd');

		if Overwrite then
			FName:=tblname+FormatDateTime('yymmdd',Now)+tblex
		else
			FName:=tblname+FormatDateTime('yymmddhhmm',Now)+tblex;

		DataToFile(tblname,AppDir+'\Send\'+FName,tblfields);

		ftp1.Host:=edthost.Text;
		ftp1.Port:=StrToInt(edtPort.text);
		ftp1.UserID:=edtUserID.Text;
		ftp1.Password:=edtPassword.Text ;
		try
			ftp1.Connect;
			PageControl1.ActivePageIndex :=0;
//      AssignFile(f,AppDir+'\Send\'+FName);
//      Size:=FileSize(f);
//      CLoseFile(f);
      Size:=10;
      if Size<>0 then
      begin
			  if edtReceivePath.Text<>'' then
				  ftp1.Upload(AppDir+'\Send\'+Fname,Trim(edtReceivePath.Text)+'/'+FName)
			  else
				  ftp1.Upload(AppDir+'\Send\'+Fname,FName);
			  PageControl1.ActivePageIndex :=2;
			  WriteCollectionLog('传输'+Fname+'成功！文件名为：'+AppDir+'\Send\'+Fname);
      end
      else
      begin
			  WriteCollectionLog('文件'+Fname+'长度为0！未传输.');
      end;
      if SendDelete then
  		  if not DeleteFile(AppDir+'\Send\'+Fname) then
				  WriteCollectionLog('删除文件失败!文件名为：'+AppDir+'\Send\'+Fname);
	except
			slblCollectionMsg.Caption:='传输'+Fname+'失败！';
			WriteCollectionLog('传输'+Fname+'失败！');
		end;

	end;
	FreePrintIni.Free ;
end;

//表名，文件名，字段列表
function TfrmFileTransfer.DataToFile(f,tn,fieldlist:String):Boolean;
var
	FileCol:TextFile;
	s,ss:String;
	i:Integer;
begin
	AssignFile(FileCol,tn) ;

  try
	try
		ReWrite(FileCol);
	except
		slblCollectionMsg.caption:='打开文件失败!';
		Result:=False;
		exit;
	end;
	qryCS.Active :=False;
	qryCS.SQL.Clear;
	qryCS.SQL.Add ('SELECT '+fieldlist+ ' FROM '+f);
	qryCS.Active :=True;
	qryCS.First;
	 prgCollection.MaxValue :=qryCS.RecordCount;
	 prgCollection.Progress:=0;
	 slblCollectionMsg.Caption:='正在由数据转换成文本。。。';
	 while not qryCS.Eof do
	 begin
		s:='''';
		for i:=0 to qryCS.Fields.Count-1 do
		begin
			ss:=Trim(qryCS.Fields[i].AsString);
			if ss='' then ss:='0';
			if ss='False' then ss:='0';
			if ss='True' then ss:='1';
		   {	if qryCS.Fields[i].DataType in [ftDate, ftTime, ftDateTime] then
			begin
				s[length(s)]:=' ';
				s:=s + ss + ',' +'''';
			end
			else }
				s:=s + ss + '''' + ',' +'''';
		end;
		s[length(s)-1]:=' ';
		s[length(s)]:=' ';
		s:=s + chr(13) + chr(10);
		write(FileCol,s);
		qryCS.Next;
		prgCollection.Progress:=prgCollection.Progress+1;
	 end;
	 CloseFile(FileCol);
	 slblCollectionMsg.Caption :='成功由数据转文本！';
	 WriteCollectionLog('成功由数据转文本！');
  except
	 slblCollectionMsg.Caption :='由数据转文本失败！';
	 WriteCollectionLog('由数据转文本失败！');
  end;
  Result:=True;
end;

procedure TfrmFileTransfer.btnReceiveClick(Sender: TObject);
var
	AppDir,sini,s:String;
	tblname,tblex,tblfields:String;
	FreePrintIni:TIniFile;
	i:Integer;
	TBList:TStringList;
begin
	AppDir:=ExtractFileDir(Application.ExeName);
	if not fileexists(AppDir+'\CSReceive.ini') then
	begin
		MessageBox(Handle,'未发现数据接收设置文件(CSReceive.ini) !','提示信息',MB_ICONINFORMATION);
		exit;
	end;
	FreePrintIni := TIniFile.Create(AppDir+'\CSReceive.ini');

	sini:=FreePrintIni.ReadString('表名', '表名列表','表1');
	TBList:=TStringList.Create ;
	TBList.Clear ;
	i:=1;
	while i<=Length(sini) do
	begin
		s:='';
		while sini[i]<>',' do
		begin
			s:=s+sini[i];
			i:=i+1;
			if i>Length(sini) then break;
		end;
		i:=i+1;
		TBList.Append(s);
	end;

	for i:=0 to TBList.Count -1 do
	begin
		tblname:=TBList.Strings[i];
		tblex:=FreePrintIni.ReadString(TBList.Strings[i],'扩展名','.csd');
		tblfields:=FreePrintIni.ReadString(TBList.Strings[i],'字段列表','.csd');
		FileToDaTa(tblname,tblex,tblfields);
	end;
	TBList.Free ;
	FreePrintIni.Free ;
end;

function TfrmFileTransfer.FileToData(f,tn,fieldlist:String):Boolean;
var
   FName:TextFile;
   i,j:integer;
   s,AppDir:string;
begin
	 AppDir:=ExtractFileDir(Application.ExeName);
	 try
		FileListBox1.ApplyFilePath(Appdir+'\Receive\*'+tn);
	 except
		//do nothing
		Result:=False;
		exit;
	 end;

{	 if not fileexists('') then
	 begin
		  MessageBox(handle,'文件不存在！','提示窗口',MB_ICONINFORMATION);
		  exit;
	 end;
}

  for j:=0 to FileListBox1.Items.Count-1 do
  begin
   try
	 AssignFile(FName,FileListBox1.Items.Strings[j]);
	 try
		ReSet(FName);
	 except
		slblReceiveMsg.Caption :='未发现文件!';
		Result:=False;
		exit;
	 end;

//	 qryCS.SQL.Clear;
//	 qryCS.SQL.Add('DELETE CODETEMP');
//	 qryCS.ExecSQL;
	 memDataFile.Clear;
	 stxtMsg.Caption:='正在读取文件数据...';
	 while not Eof(FName) do
	 begin
		Readln(FName,s);
		memDataFile.Lines.Add(s);
	 end;
	 CloseFile(FName);
	 stxtMsg.Caption:='正在由文本转换成数据。。。';
	 prgReceive.MaxValue:=memDataFile.Lines.Count;
	 prgReceive.Progress:=0;
	 for i:=0 to memDataFile.Lines.Count do
	 begin
		s:=memDataFile.Lines[i];
		if fieldlist<>'*' then
			s:='INSERT INTO '+f+'('+fieldlist+') VALUES(' + s + ')'
		else
			s:='INSERT INTO '+f+' VALUES(' + s + ')';
		qryCS.SQL.Clear;
		qryCS.SQL.Add(s);
		try
			qryCS.ExecSQL;
		except
		end;
		prgReceive.Progress:=prgReceive.Progress+1;
	 end;
	 prgReceive.Progress:=prgReceive.MaxValue ;
	 slblReceiveMsg.Caption:='文本转换成数据成功！';
	 if not DeleteFile(FileListBox1.Items.Strings[j]) then
		WriteReceiveLog('删除文件失败!文件名为：'+FileListBox1.Items.Strings[j]);
	 WriteReceiveLog('文本转换成数据成功！文件名为：'+FileListBox1.Items.Strings[j]);
   except
	 slblReceiveMsg.Caption:='文本转换成数据失败！';
	 WriteReceiveLog('文本转换成数据失败！文件名为：'+FileListBox1.Items.Strings[j]);
   end;
  end;
  Result:=True;
end;

procedure TfrmFileTransfer.BitBtn6Click(Sender: TObject);
var
	AppDir:String;
begin
    if MessageBox(Handle,'确定要清除日志文件吗？','提示信息',MB_ICONQUESTION+MB_YESNO)=ID_NO then exit;
	AppDir:=ExtractFileDir(Application.ExeName);
	if not DeleteFile(AppDir+'\Log\Collection.Log') then MessageBox(Handle,'清空汇总日志时发生错误！','提示窗口',MB_ICONINFORMATION);
	memTransferLog.Clear ;
end;

procedure TfrmFileTransfer.BitBtn8Click(Sender: TObject);
var
	AppDir:String;
begin
    if MessageBox(Handle,'确定要清除日志文件吗？','提示信息',MB_ICONQUESTION+MB_YESNO)=ID_NO then exit;
	AppDir:=ExtractFileDir(Application.ExeName);
	if not DeleteFile(AppDir+'\Log\Receive.Log') then MessageBox(Handle,'清空接收日志时发生错误！','提示窗口',MB_ICONINFORMATION);
	memTransferLog.Clear ;
end;

procedure TfrmFileTransfer.btnViewLog(Sender: TObject);
var
	FName:TextFile;
	AppDir,s:String;
begin
	 AppDir:=ExtractFileDir(Application.ExeName);
	 if (Sender AS TBitBtn).Tag=0 then
	 begin
		slblLogMsg.Caption :='汇总日志';
		AssignFile(FName,AppDir+'\Log\Collection.Log');
	 end
	 else if (Sender AS TBitBtn).Tag=1 then
	 begin
		slblLogMsg.Caption :='接收日志';
		AssignFile(FName,AppDir+'\Log\Receive.Log');
	 end;
	 memTransferLog.Clear;
	 try
		ReSet(FName);
	 except
		MessageBox(Handle,'未发现日志文件！','信息窗口',MB_ICONINFORMATION);
		exit;
	 end;
	 while not Eof(FName) do
	 begin
		Readln(FName,s);
		memTransferLog.Lines.Add(s);
	 end;
	 CloseFile(FName);
end;

procedure TfrmFileTransfer.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
	if MessageBox(handle,'确定要退出文件传输管理吗？','提示窗口',MB_ICONQUESTION+MB_YESNO)=IDYES then
    begin
		SaveReg;
		SaveSendTables;
		Application.Terminate ;
	end;
end;

procedure TfrmFileTransfer.Image1Click(Sender: TObject);
begin
	self.Hide ;
end;

procedure TfrmFileTransfer.TrayIcon1Click(Sender: TObject);
begin
	self.Show ;
end;

procedure TfrmFileTransfer.N4Click(Sender: TObject);
begin
	self.show;
end;

procedure TfrmFileTransfer.TrayIcon1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
	if Button=mbRight then mnTrayIcon.Popup(x,y);
end;

procedure TfrmFileTransfer.Image2Click(Sender: TObject);
begin
    Randomize;
	case Random(4) of
	0:
		Cross(Image3,image2);
	1:
		Pwindows(Image3,image2);
	2:
		Push(Image3,image2);
	3:
		PWindows(Image3,image2);
	end;
end;

procedure TfrmFileTransfer.Image3DblClick(Sender: TObject);
begin
  database1.Connected :=True;
end;

procedure TfrmFileTransfer.Timer2Timer(Sender: TObject);
var
  tmr:String;
begin
  tmr:=FormatDateTime('yyyy-mm-dd',Time);
  tmr:=tmr+' 18:00:00';
  if FormatDateTime('yyyy-mm-dd hh:mm:ss',Time)<>tmr then exit;
  btnCollectionClick(self);
end;

procedure TfrmFileTransfer.btnOpenLinkClick(Sender: TObject);
begin
  inherited;
  MessageBox(handle,'数据别名为TXTrans','提示信息',MB_ICONINFORMATION);
  try
    Database1.Connected :=True;
    MessageBox(handle,'成功打开连接！','提示信息',MB_ICONINFORMATION);
  except
    MessageBox(handle,'打开连接失败！','提示信息',MB_ICONINFORMATION);
  end;
end;

end.