小弟先前為了系統的需要，寫了一個Run timer的ftp(indy)上傳程式，偶有錯誤，無法上傳倒無所謂…，但卻不能停下來，可是現在用了很多的try卻仍常出現“OPEN DATA CONNECTION ERROR”的message，致使程式中斷…真是非常苦惱啊!!! 可否請有此方面經驗的前輩們給予一盞明燈! 感激不盡…orz

建議列出程式碼才好判定. 雪龍 http://bestlong.no-ip.com/ 學海無涯覺無盡，勤做筆記防失憶

------
http://blog.bestlong.idv.tw/
http://www.bestlong.idv.tw/
http://delphi-ktop.bestlong.idv.tw/

引言: 建議列出程式碼才好判定. 雪龍 http://bestlong.no-ip.com/ 學海無涯覺無盡，勤做筆記防失憶

抱歉，程式有點小長，主要的程序在Button1Click。 最近又常發生“Not Connect”的訊息…都攔不住，真的快瘋了…><" unit main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, IdIntercept, IdLogBase, IdLogEvent, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP, ComCtrls,IniFiles,DateUtils, IdAntiFreezeBase, IdAntiFreeze,IdFTPCommon, ExtCtrls,IdFTPList, FileCtrl, Mask, Buttons; type TForm1 = class(TForm) IdFTP1: TIdFTP; IdLogEvent1: TIdLogEvent; IdAntiFreeze1: TIdAntiFreeze; Panel1: TPanel; Splitter1: TSplitter; HeaderControl1: THeaderControl; DirListBox: TListBox; RichEdit1: TRichEdit; Panel2: TPanel; Label1: TLabel; EditHost: TEdit; Label2: TLabel; EditUser: TEdit; Label3: TLabel; Label4: TLabel; Button1: TButton; FileListBox1: TFileListBox; Timer1: TTimer; StatusBar1: TStatusBar; EditPass: TMaskEdit; ButtonStop: TBitBtn; CheckTrace: TCheckBox; Bevel1: TBevel; EditInterval: TMaskEdit; BitBtn1: TBitBtn; Label5: TLabel; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure IdLogEvent1Received(ASender: TComponent; const AText, AData: String); procedure IdLogEvent1Sent(ASender: TComponent; const AText, AData: String); procedure ChageDir(DirName: String); procedure HeaderControl1Resize(Sender: TObject); procedure DirListBoxDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure ButtonStopClick(Sender: TObject); procedure CheckTraceClick(Sender: TObject); procedure BitBtn1Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } public { Public declarations } end; var Form1: TForm1; p_dir,p_recetmp:String; p_ma_no:String; function DtoS(YMD: TDate):String; function StrZero(m_num:integer;m_len:integer):String; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var m_filecount:integer; m_ii:integer; m_source,m_target,m_file:String; m_kd:Char; m_time:string; f_time:textfile; begin Label5.Caption:=IntToStr(StrToInt(Label5.Caption) 1); //timer每跑十次後，將idftp直接斷線，試著解決程式關不掉問題，但仍會發生程式關閉不了問題 IF Label5.Caption='10' then begin TRY idftp1.Disconnect; idftp1.FreeOnRelease; FINALLY Label5.Caption:='0'; end; end; IF idftp1.Connected then Exit; idftp1.Host:=TRIM(EditHost.Text); idftp1.Username:=TRIM(EditUser.Text); idftp1.Password:=TRIM(EditPass.Text); TRY StatusBar1.Panels[0].Text:='連線中…'; idftp1.Connect; m_time:=DatetimeToStr(NOW); RichEdit1.SelAttributes.Color:=clGreen; RichEdit1.Lines.Add('***連線成功***' m_time); EXCEPT RichEdit1.SelLength; RichEdit1.SelAttributes.Color:=clRed; m_time:=DatetimeToStr(now); RichEdit1.Lines.Add('***連線失敗，稍後再試***' m_time); //idftp1.Disconnect; EXIT; END; TRY AssignFile(f_time,p_dir 'recetmp\' p_ma_no '\now.txt'); rewrite(f_time); Writeln(f_time,DateTimeToStr(now())); CloseFile(f_time); EXCEPT m_time:=DatetimeToStr(now); RichEdit1.Lines.Add('***now時間上產生失數，稍後再試***' m_time); idftp1.Disconnect; END; StatusBar1.Panels[0].Text:='連線傳輸中!'; RichEdit1.Lines.Add('***切換目錄***' m_time); TRY chagedir('\recetmp\'); EXCEPT TRY Idftp1.MakeDir('recetmp'); SLEEP(500); chagedir('\recetmp\'); EXCEPT m_time:=DatetimeToStr(now); RichEdit1.Lines.Add('***連線中斷，稍後再試***' m_time); idftp1.Disconnect; EXIT; END; END; TRY chagedir('\recetmp\' p_ma_no); SLEEP(500); EXCEPT TRY Idftp1.MakeDir(p_ma_no); SLEEP(500); chagedir('\recetmp\' p_ma_no '\'); EXCEPT m_time:=DatetimeToStr(now); RichEdit1.Lines.Add('***連線中斷，稍後再試***' m_time); idftp1.Disconnect; EXIT; END; END; RichEdit1.Lines.Add('***資料傳輸***' m_time); FileListbox1.Directory:=p_dir 'recetmp\' p_ma_no; FileListbox1.Refresh; if IdFTP1.Connected then begin m_ii:=0; FileListBox1.Mask:='*.TXT'; m_filecount:=FileListbox1.Count; WHILE m_ii<=m_filecount-1 DO begin FileListbox1.ItemIndex:=m_ii; m_source:=FileListBox1.FileName; m_file:=UPPERCASE(ExtractFileName(m_source)); m_kd:=m_file[1]; m_target:='\recetmp\' p_ma_no; IdFTP1.TransferType := ftBinary; IF m_kd IN ['I','P','M','T'] THEN BEGIN IF DTOS(DATE())<>INTTOSTR(STRTOINT(COPY(m_file,2,7)) 19110000) THEN begin m_ii:=m_ii 1; Continue; end; END; //避免在傳檔時，剛好系統也在寫檔而出錯，因為此將檔案拷至package\sfv1\recetmp再上傳 TRY CopyFile(PChar(m_source),PChar(p_recetmp ExtractFileName(m_source)),false); EXCEPT RichEdit1.SelLength; RichEdit1.SelAttributes.Color:=clRed; m_time:=DatetimeToStr(now); RichEdit1.Lines.Add('***' m_source '檔案拷貝失敗，稍後再試***' m_time); m_source:=p_recetmp ExtractFileName(m_source); END; TRY IdFTP1.Put(m_source, m_file); SLEEP(500); ChageDir(idftp1.RetrieveCurrentDir); EXCEPT RichEdit1.SelLength; RichEdit1.SelAttributes.Color:=clRed; m_time:=DatetimeToStr(now); RichEdit1.Lines.Add('***' m_source '上傳失敗，稍後再試***' m_time); END; IF (UPPERCASE(COPY(m_file,1,6))='RECNOW') AND (FILEEXISTS(p_dir 'recetmp\' p_ma_no '\' DTOS(DATE()) '.NOW')) THEN begin m_file:='R' STRZERO(StrToInt(DTOS(DATE()))-19110000,7) '.' COPY(m_file,7,2); TRY IdFTP1.Put(m_source, m_file); SLEEP(500); ChageDir(idftp1.RetrieveCurrentDir); EXCEPT RichEdit1.SelLength; RichEdit1.SelAttributes.Color:=clRed; m_time:=DatetimeToStr(now); RichEdit1.Lines.Add('***' m_source '上傳失敗，稍後再試***' m_time); END; end; m_ii:=m_ii 1; end; end; IF idftp1.Connected then begin TRY idftp1.Disconnect; FINALLY StatusBar1.Panels[0].Text:='等待中…'; END; end; end; procedure TForm1.FormCreate(Sender: TObject); Var set_ini:Tinifile; begin IF not FileExists(ExtractFilePath(ParamStr(0)) 'set.ini') THEN begin set_ini:=TIniFile.Create(ExtractFilePath(ParamStr(0)) 'set.ini'); set_ini.WriteString('INIT', 'HOST','192.68.1.1'); set_ini.WriteString('INIT', 'USER','Account'); set_ini.WriteString('INIT', 'PASSWORD','password'); set_ini.WriteString('INIT', 'INTERVAL','30'); set_ini.Free; end; idftp1.Intercept:=idLogEvent1; set_ini:=TIniFile.Create(ExtractFilePath(ParamStr(0)) 'set.ini'); EditHost.Text:= set_ini.ReadString('INIT', 'HOST','HOST'); EditUser.Text:= set_ini.ReadString('INIT', 'USER','USER'); EditPass.Text:= set_ini.ReadString('INIT', 'PASSWORD','PASSWORD'); EditInterval.Text:= set_ini.ReadString('INIT', 'INTERVAL','INTERVAL'); set_ini.Free; p_dir:=GetEnvironmentVariable('POS_DIR'); p_recetmp:=p_dir 'recetmp\'; p_ma_no:=GetEnvironmentVariable('MA_NO'); Timer1.Interval:=StrToInt(TRIM(EditInterval.text))*1000; end; procedure TForm1.IdLogEvent1Received(ASender: TComponent; const AText, AData: String); begin RichEdit1.SelLength; RichEdit1.SelAttributes.Color:=clGreen; RichEdit1.Lines.Add('<<< ' adata); RichEdit1.SetFocus; end; procedure TForm1.IdLogEvent1Sent(ASender: TComponent; const AText, AData: String); begin RichEdit1.SelLength; RichEdit1.SelAttributes.Color:=clBlue; RichEdit1.Lines.Add('>>> ' adata); end; procedure TForm1.ChageDir(DirName: String); Var LS: TStringList; begin LS := TStringList.Create; try IdFTP1.ChangeDir(DirName); IdFTP1.TransferType := ftASCII; DirListBox.Items.Clear; IdFTP1.List(LS); DirListBox.Items.Assign(ls); if DirListBox.Items.Count > 0 then if AnsiPos('total', DirListBox.Items[0]) > 0 then DirListBox.Items.Delete(0); finally LS.Free; end; end; procedure TForm1.HeaderControl1Resize(Sender: TObject); begin DirListBox.Repaint; end; procedure TForm1.DirListBoxDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); Var R: TRect; begin if odSelected in State then begin DirListBox.Canvas.Brush.Color := $00895F0A; DirListBox.Canvas.Font.Color := clWhite; end else DirListBox.Canvas.Brush.Color := clWindow; if Assigned(IdFTP1.DirectoryListing) and (IdFTP1.DirectoryListing.Count > Index) then begin DirListBox.Canvas.FillRect(Rect); with IdFTP1.DirectoryListing.Items[Index] do begin DirListBox.Canvas.TextOut(Rect.Left, Rect.Top, FileName); R := Rect; R.Left := Rect.Left HeaderControl1.Sections.Items[0].Width; R.Right := R.Left HeaderControl1.Sections.Items[1].Width; DirListBox.Canvas.FillRect(R); DirListBox.Canvas.TextOut(R.Left, Rect.Top, IntToStr(Size)); R.Left := R.Right; R.Right := R.Left HeaderControl1.Sections.Items[2].Width; DirListBox.Canvas.FillRect(R); if ItemType = ditDirectory then begin DirListBox.Canvas.Font.Color:=clred; DirListBox.Canvas.TextOut(R.Left, Rect.Top, 'Directory'); DirListBox.Canvas.Font.Color:=clblack; end else DirListBox.Canvas.TextOut(R.Left, Rect.Top, 'File'); R.Left := R.Right; R.Right := R.Left HeaderControl1.Sections.Items[3].Width; DirListBox.Canvas.FillRect(R); DirListBox.Canvas.TextOut(R.Left, Rect.Top, FormatDateTime('mm/dd/yyyy hh:mm', ModifiedDate)); R.Left := R.Right; R.Right := R.Left HeaderControl1.Sections.Items[4].Width; DirListBox.Canvas.FillRect(R); DirListBox.Canvas.TextOut(R.Left, Rect.Top, GroupName); R.Left := R.Right; R.Right := R.Left HeaderControl1.Sections.Items[5].Width; DirListBox.Canvas.FillRect(R); DirListBox.Canvas.TextOut(R.Left, Rect.Top, OwnerName); R.Left := R.Right; R.Right := R.Left HeaderControl1.Sections.Items[6].Width; DirListBox.Canvas.FillRect(R); DirListBox.Canvas.TextOut(R.Left, Rect.Top, OwnerPermissions GroupPermissions UserPermissions); end; end; end; function DtoS(YMD: TDate): String; var YY, MM, DD: Word; RetStr: String; begin DecodeDate(YMD, YY, MM, DD); RetStr := IntToStr(YY); if MM < 10 then RetStr := RetStr '0' IntToStr(MM) else RetStr := RetStr IntToStr(MM); if DD < 10 then RetStr := RetStr '0' IntToStr(DD) else RetStr := RetStr IntToStr(DD); Result := RetStr; end; function StrZero(m_num:integer;m_len:integer):String; //將數字轉為字串，並於前方補零 Var m_retstr:String; m_ii:integer; begin m_retstr:= InttoStr(m_num); For m_ii := 1 to (m_len-Length(InttoStr(m_num))) do begin m_retstr := '0' m_retstr; end; Result := m_retstr; end; procedure TForm1.ButtonStopClick(Sender: TObject); begin IF ButtonStop.Caption='暫停' THEN begin Timer1.Enabled:=false; ButtonStop.Caption:='啟動'; ButtonStop.Font.Color:=clRed; end ELSE begin Timer1.Enabled:=true; ButtonStop.Caption:='暫停'; ButtonStop.Font.Color:=clBlue; end; end; procedure TForm1.CheckTraceClick(Sender: TObject); begin IdLogEvent1.Active:=CheckTrace.Checked; end; procedure TForm1.BitBtn1Click(Sender: TObject); Var set_ini:Tinifile; begin idftp1.Intercept:=idLogEvent1; set_ini:=TIniFile.Create(ExtractFilePath(ParamStr(0)) 'set.ini'); set_ini.WriteString('INIT', 'HOST',EditHost.Text); set_ini.WriteString('INIT', 'USER',EditUser.Text); set_ini.WriteString('INIT', 'PASSWORD',EditPass.Text); set_ini.WriteString('INIT', 'INTERVAL',EditInterval.Text); set_ini.Free; showmessage('存檔完成!'); end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin timer1.Enabled:=false; IF messagebox(0,'銷售資料將無法再傳至總公司，確定離開嗎?','警告',MB_YesNo MB_ICONQUESTION)=IDNO then begin timer1.Enabled:=true; ABORT; end ELSE begin idftp1.quit; idftp1.Abort; idftp1.FreeOnRelease; end; end; end.

小弟認為是沒攔到紅色那行出現的錯誤訊息.

procedure TForm1.DirListBoxDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
Var
  R: TRect;
begin
  if odSelected in State then begin
    DirListBox.Canvas.Brush.Color := $00895F0A;
    DirListBox.Canvas.Font.Color := clWhite;
  end
  else
    DirListBox.Canvas.Brush.Color := clWindow;      if Assigned(IdFTP1.DirectoryListing) and (IdFTP1.DirectoryListing.Count > Index) then begin
    DirListBox.Canvas.FillRect(Rect);
    with IdFTP1.DirectoryListing.Items[Index] do begin
      DirListBox.Canvas.TextOut(Rect.Left, Rect.Top, FileName);
      R := Rect;

-- hagar.

程式碼最好前後加上 [ code ] 和 [ /code ], 顯示時候會有排縮, 看起來比較輕鬆舒服 [ code ] 您的程式碼 [/ code ] 其中 [ , code, ] 間不可有空白 ********************* 如果您滿意答案,請結案 ********************* 發表人 - pcboy2 於 2005/05/09 12:08:32

------
能力不足，求助於人；有能力時，幫幫別人；如果您滿意答覆，請適時結案！

子曰：問有三種，不懂則問，雖懂有疑則問，雖懂而想知更多則問！

hagar版大，非常感謝您，我目前依你的方法測試，問題已經解決了一大半了，剩下的我繼續努力:p，而三感謝!! class="code">，保護大家的眼睛!

提問者您好:


以上回應是否已得到滿意的答覆？


若已得到滿意的答覆，請在一週內結案，否則請在一週內回覆還有什麼未盡事宜，不然，
將由版主(尚無版主之區域將由副站長或站長)採自由心證,選擇較合適之解答予以結案處理，
被選上之答題者同樣會有加分獎勵，同時發問者將受到扣 1 分的處分。不便之處，請見諒。


有問有答有結案，才能有良性的互動，良好的討論環境需要大家共同維護，感謝您的配合。

------
我是機器人,我不接受簡訊.