請教各位先進,因錯誤實在查不出為什麼所以看大家是否有遇過 |
答題得分者是:syntax
|
cobraliu
中階會員 發表:15 回覆:75 積分:83 註冊:2007-11-22 發送簡訊給我 |
unit Unit9;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, Grids, DBGrids, StdCtrls, ToolWin, ExtCtrls; type TFUpLoadData = class(TForm) StatusBar1: TStatusBar; ToolBar1: TToolBar; ToolButton1: TToolButton; ToolButton4: TToolButton; ToolButton5: TToolButton; Ed_upload_dir: TEdit; Label1: TLabel; Label2: TLabel; StringGrid1: TStringGrid; Bevel1: TBevel; Button1: TButton; procedure ToolButton4Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure ToolButton1Click(Sender: TObject); procedure FormActivate(Sender: TObject); private { Private declarations } public { Public declarations } end; var FUpLoadData: TFUpLoadData; FUNCTION FNotHaveText(FromText,FromNotText:String):String;far;external '.\dll\text_process.dll'; FUNCTION FReplaceChar(FromText,FromWhatText,FromReplace:STRING):String;far;external '.\dll\text_process.dll'; implementation uses Unit1, Unit7; {$R *.dfm} PROCEDURE PGetDirFile(From_dir,From_dir1:String); VAR sr1:TSearchRec; FileAttrs1:Integer; BEGIN FileAttrs1 := faAnyFile; IF FindFirst(From_dir,FileAttrs1,sr1) = 0 THEN BEGIN Repeat IF (sr1.Attr AND FileAttrs1) = Sr1.Attr THEN IF (sr1.Name <> '.') AND (sr1.Name <> '..') THEN BEGIN fuploaddata.stringgrid1.RowCount := fuploaddata.stringgrid1.RowCount 1; fuploaddata.stringgrid1.Cells[0,fuploaddata.stringgrid1.RowCount] := sr1.Name; IF (sr1.Attr AND fadirectory) = fadirectory THEN BEGIN fuploaddata.stringgrid1.Cells[1,fuploaddata.stringgrid1.RowCount] := 'DIR'; PGetDirFile((From_dir '\' sr1.Name '\*.*'),(From_dir '\' sr1.Name)); END ELSE BEGIN fuploaddata.stringgrid1.Cells[1,fuploaddata.stringgrid1.RowCount] := 'FILE'; fuploaddata.stringgrid1.Cells[3,fuploaddata.stringgrid1.RowCount] := From_dir1 '\' sr1.Name; fuploaddata.stringgrid1.Cells[4,fuploaddata.stringgrid1.RowCount] := FReplaceChar(FNotHaveText(From_dir1,(f_get_system('PROG_DIR') '\Upload')),'\','/') '/' sr1.Name; END; END; Until FindNext(sr1) <> 0; Findclose(sr1); END; END; procedure TFUpLoadData.ToolButton4Click(Sender: TObject); begin close; end; procedure TFUpLoadData.FormCreate(Sender: TObject); VAR sr:TSearchRec; FileAttrs:Integer; begin FileAttrs := faAnyFile; With stringgrid1 do BEGIN stringgrid1.Cells[0,0] := '名稱'; stringgrid1.Cells[1,0] := '檔案/目錄'; stringgrid1.Cells[2,0] := '上傳'; stringgrid1.Cells[3,0] := '檔案目錄'; stringgrid1.Cells[4,0] := '上傳位置'; stringgrid1.RowCount := 1; IF FindFirst(f_get_system('PROG_DIR') '\Upload\*.*',FileAttrs,sr) = 0 THEN BEGIN Repeat IF (sr.Attr AND FileAttrs) = Sr.Attr THEN IF (sr.Name <> '.') AND (sr.Name <> '..') THEN BEGIN fuploaddata.stringgrid1.Cells[0,fuploaddata.stringgrid1.RowCount] := sr.Name; IF (sr.Attr AND fadirectory) = fadirectory THEN BEGIN fuploaddata.stringgrid1.Cells[1,fuploaddata.stringgrid1.RowCount] := 'DIR'; PGetDirFile((f_get_system('PROG_DIR') '\Upload' '\' sr.Name '\*.*'),(f_get_system('PROG_DIR') '\Upload' '\' sr.Name)); END ELSE BEGIN fuploaddata.stringgrid1.Cells[1,fuploaddata.stringgrid1.RowCount] := 'FILE'; fuploaddata.stringgrid1.Cells[3,fuploaddata.stringgrid1.RowCount] := f_get_system('PROG_DIR') '\Upload' '\' sr.Name; fuploaddata.stringgrid1.Cells[4,fuploaddata.stringgrid1.RowCount] := sr.Name; END; fuploaddata.stringgrid1.RowCount := fuploaddata.stringgrid1.RowCount 1; END; Until FindNext(sr) <> 0; Findclose(sr); END; END; end; end. 以上是Unit的程式碼,下列是Dll library text_process; uses SysUtils, Classes, Dialogs; FUNCTION FReplaceChar(FromText,FromWhatText,FromReplace:STRING):String;Export; VAR RetData:String; W_i:Integer; W_length:Integer; IsExit:BOOLEAN; BEGIN w_i := 1; W_length := Length(FromWhatText); IsExit:=TRUE; While (w_i <= Length(FromText)) AND IsExit DO BEGIN IF (COPY(FromText,w_i,w_length) = FromWhatText) THEN BEGIN RetData := RetData FromReplace; w_i := w_i w_length; END ELSE BEGIN RetData := RetData Copy(FromText,w_i,1); w_i := w_i 1; END; IF (w_i w_length) = Length(FromText) THEN IsExit := FALSE; END; Result:=RetData; END; FUNCTION FNotHaveText(FromText,FromNotText:String):String;Export; VAR RetData:String; W_i:Integer; W_length:Integer; IsExit:BOOLEAN; BEGIN w_i := 1; IsExit := TRUE; W_length := Length(FromNotText); WHILE (w_i <= Length(FromText)) AND IsExit DO BEGIN IF (COPY(FromText,w_i,w_length) = FromNotText) THEN BEGIN w_i := w_i w_length; END ELSE BEGIN RetData := RetData Copy(FromText,w_i,1); w_i := w_i 1; END; IF (w_i w_length) = Length(FromText) THEN IsExit := FALSE; END; Result:=RetData; END; exports FNotHaveText,FReplaceChar; {$R *.res} begin end. 他會Show的錯誤訊息如下 Project Project1.exe raised exception class EaccessViolation with message 'Access violation at address 002321B6 in module 'text_process.dll'.Write of address 00000016'. Process stopped.Use Step or Run to continue. FNotHaveText:功能是傳入的字串不能含有另一傳入的字串 如: FNotHaveText('aaabbbccc','aaa')回傳bbbccc FReplaceChar:功能是取代字串 如:FReplaceChar('aaaeeeddfffg','aaa','GGG')回傳GGGeeeddfffg 小弟在試過在dll中下訊息,實上上他執行上沒有問題,但大約Run10筆資料以後程式就出錯了,就會出那個訊息,所以實在不懂為什麼,請問有大大可以幫忙解釋嗎..@@ 紅色字標明的部份是call dll的地方
------
初學、初學、學了很久...還是在初學階段..Orz |
syntax
尊榮會員 發表:26 回覆:1139 積分:1258 註冊:2002-04-23 發送簡訊給我 |
大致看了一下,沒有很詳細看(沒有適當註解,或解釋你的意圖,通常人都不想看)
但可以跟你說幾個重點 1. DLL 不是 Delphi 專用,或許在 DLL 內可以使用 Delphi 的一些專用語法與物件,但與 DLL 溝通的介面,一定要是通用的型態,例如,指標,整數,所以 FUNCTION FReplaceChar(FromText,FromWhatText,FromReplace:STRING):String;far;external 是你問題的來源,就算全都是使用 Delphi 來設計,DLL 的規則還是要遵守,不然幹嘛用 DLL,用 BPL 不就得了 你可能需要重新學習 DLL 的相關知識,來修正你目前對 DLL的理解 2. HELP還是要看,這不知道多少人,說過多少次,請去看 Delphi 的 Help 有關 DLL 與 String 你就會知道,其實還是可以使用 String,只是需要多做一些工作,這裡我就不重複 Delohi Help 內已有的東西 3. 你的程式運作上效率並不會很好,例如 IF (COPY(FromText,w_i,w_length) = FromWhatText) THEN 不知道為何要先 Copy 再比較,感覺像在脫褲子放屁,沒辦法直接比較嗎? 如果你懂電腦的詳細 CPU 運作,就會知道,直接比可以省很多時間 更不用說是在迴圈內,會造成大量的時間浪費 看是要用 memcmp, CompareMem 或是 stricmp, strcmp 之類的直接比 IF CompareMem(FromText[1], FromWhatText[1], W_length) THEN 4. 看你的程式,實在是一種酷刑阿! FUNCTION FNotHaveText(FromText,FromNotText:String):String;far;external '.\dll\text_process.dll'; FUNCTION FReplaceChar(FromText,FromWhatText,FromReplace:STRING):String;far;external 這兩個 function ,你的意圖何在,是設計用來浪費電腦計算能力的嗎?你自己可以思考一下,你的目的為何,然後這樣做的理由,自然你就會發現你的問題何在 就算大概看一下,看完,頭還是很痛,說實在,也看不太懂,只能大率猜出你的意圖,因為太多「廢」程式碼,與無意義的 algorithm,你想要做的是,Delphi 早就有函式可以處理,為何要自己做?就算函式不全如己意,也只需要稍做修改即可 不過如果是要練習,那倒是可以,但是,不管意圖為何,該程式碼的演算法與效率,都需要大大加強 以上是個人一點看法 ===================引 用 cobraliu 文 章=================== unit Unit9; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, Grids, DBGrids, StdCtrls, ToolWin, ExtCtrls; type TFUpLoadData = class(TForm) StatusBar1: TStatusBar; ToolBar1: TToolBar; ToolButton1: TToolButton; ToolButton4: TToolButton; ToolButton5: TToolButton; Ed_upload_dir: TEdit; Label1: TLabel; Label2: TLabel; StringGrid1: TStringGrid; Bevel1: TBevel; Button1: TButton; procedure ToolButton4Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure ToolButton1Click(Sender: TObject); procedure FormActivate(Sender: TObject); private { Private declarations } public { Public declarations } end; var FUpLoadData: TFUpLoadData; FUNCTION FNotHaveText(FromText,FromNotText:String):String;far;external '.\dll\text_process.dll'; FUNCTION FReplaceChar(FromText,FromWhatText,FromReplace:STRING):String;far;external '.\dll\text_process.dll'; implementation uses Unit1, Unit7; {$R *.dfm} PROCEDURE PGetDirFile(From_dir,From_dir1:String); VAR sr1:TSearchRec; FileAttrs1:Integer; BEGIN FileAttrs1 := faAnyFile; IF FindFirst(From_dir,FileAttrs1,sr1) = 0 THEN BEGIN Repeat IF (sr1.Attr AND FileAttrs1) = Sr1.Attr THEN IF (sr1.Name <> '.') AND (sr1.Name <> '..') THEN BEGIN fuploaddata.stringgrid1.RowCount := fuploaddata.stringgrid1.RowCount 1; fuploaddata.stringgrid1.Cells[0,fuploaddata.stringgrid1.RowCount] := sr1.Name; IF (sr1.Attr AND fadirectory) = fadirectory THEN BEGIN fuploaddata.stringgrid1.Cells[1,fuploaddata.stringgrid1.RowCount] := 'DIR'; PGetDirFile((From_dir '\' sr1.Name '\*.*'),(From_dir '\' sr1.Name)); END ELSE BEGIN fuploaddata.stringgrid1.Cells[1,fuploaddata.stringgrid1.RowCount] := 'FILE'; fuploaddata.stringgrid1.Cells[3,fuploaddata.stringgrid1.RowCount] := From_dir1 '\' sr1.Name; fuploaddata.stringgrid1.Cells[4,fuploaddata.stringgrid1.RowCount] := FReplaceChar(FNotHaveText(From_dir1,(f_get_system('PROG_DIR') '\Upload')),'\','/') '/' sr1.Name; END; END; Until FindNext(sr1) <> 0; Findclose(sr1); END; END; procedure TFUpLoadData.ToolButton4Click(Sender: TObject); begin close; end; procedure TFUpLoadData.FormCreate(Sender: TObject); VAR sr:TSearchRec; FileAttrs:Integer; begin FileAttrs := faAnyFile; With stringgrid1 do BEGIN stringgrid1.Cells[0,0] := '名稱'; stringgrid1.Cells[1,0] := '檔案/目錄'; stringgrid1.Cells[2,0] := '上傳'; stringgrid1.Cells[3,0] := '檔案目錄'; stringgrid1.Cells[4,0] := '上傳位置'; stringgrid1.RowCount := 1; IF FindFirst(f_get_system('PROG_DIR') '\Upload\*.*',FileAttrs,sr) = 0 THEN BEGIN Repeat IF (sr.Attr AND FileAttrs) = Sr.Attr THEN IF (sr.Name <> '.') AND (sr.Name <> '..') THEN BEGIN fuploaddata.stringgrid1.Cells[0,fuploaddata.stringgrid1.RowCount] := sr.Name; IF (sr.Attr AND fadirectory) = fadirectory THEN BEGIN fuploaddata.stringgrid1.Cells[1,fuploaddata.stringgrid1.RowCount] := 'DIR'; PGetDirFile((f_get_system('PROG_DIR') '\Upload' '\' sr.Name '\*.*'),(f_get_system('PROG_DIR') '\Upload' '\' sr.Name)); END ELSE BEGIN fuploaddata.stringgrid1.Cells[1,fuploaddata.stringgrid1.RowCount] := 'FILE'; fuploaddata.stringgrid1.Cells[3,fuploaddata.stringgrid1.RowCount] := f_get_system('PROG_DIR') '\Upload' '\' sr.Name; fuploaddata.stringgrid1.Cells[4,fuploaddata.stringgrid1.RowCount] := sr.Name; END; fuploaddata.stringgrid1.RowCount := fuploaddata.stringgrid1.RowCount 1; END; Until FindNext(sr) <> 0; Findclose(sr); END; END; end; end. 以上是Unit的程式碼,下列是Dll library text_process; uses SysUtils, Classes, Dialogs; FUNCTION FReplaceChar(FromText,FromWhatText,FromReplace:STRING):String;Export; VAR RetData:String; W_i:Integer; W_length:Integer; IsExit:BOOLEAN; BEGIN w_i := 1; W_length := Length(FromWhatText); IsExit:=TRUE; While (w_i <= Length(FromText)) AND IsExit DO BEGIN IF (COPY(FromText,w_i,w_length) = FromWhatText) THEN BEGIN RetData := RetData FromReplace; w_i := w_i w_length; END ELSE BEGIN RetData := RetData Copy(FromText,w_i,1); w_i := w_i 1; END; IF (w_i w_length) = Length(FromText) THEN IsExit := FALSE; END; Result:=RetData; END; FUNCTION FNotHaveText(FromText,FromNotText:String):String;Export; VAR RetData:String; W_i:Integer; W_length:Integer; IsExit:BOOLEAN; BEGIN w_i := 1; IsExit := TRUE; W_length := Length(FromNotText); WHILE (w_i <= Length(FromText)) AND IsExit DO BEGIN IF (COPY(FromText,w_i,w_length) = FromNotText) THEN BEGIN w_i := w_i w_length; END ELSE BEGIN RetData := RetData Copy(FromText,w_i,1); w_i := w_i 1; END; IF (w_i w_length) = Length(FromText) THEN IsExit := FALSE; END; Result:=RetData; END; exports FNotHaveText,FReplaceChar; {$R *.res} begin end. 他會Show的錯誤訊息如下 Project Project1.exe raised exception class EaccessViolation with message 'Access violation at address 002321B6 in module 'text_process.dll'.Write of address 00000016'. Process stopped.Use Step or Run to continue. FNotHaveText:功能是傳入的字串不能含有另一傳入的字串 如: FNotHaveText('aaabbbccc','aaa')回傳bbbccc FReplaceChar:功能是取代字串 如:FReplaceChar('aaaeeeddfffg','aaa','GGG')回傳GGGeeeddfffg 小弟在試過在dll中下訊息,實上上他執行上沒有問題,但大約Run10筆資料以後程式就出錯了,就會出那個訊息,所以實在不懂為什麼,請問有大大可以幫忙解釋嗎..@@ 紅色字標明的部份是call dll的地方 |
cobraliu
中階會員 發表:15 回覆:75 積分:83 註冊:2007-11-22 發送簡訊給我 |
謝謝syntan大大的指教
程式沒有加上說明,這是個人習慣沒有很好 Sorry,自已會改進這一部份 其實自已有先做功課(查舊文、google大神、help),這一些都有做...@@ 上述的程式其實主要是FTP截資料下來要判定用的,應該是自已在Delphi技術不夠..@@ 其實有一些函數自已是不知道(因沒有方向,找的方向)所以並沒有用那一些方法在做,所以為了達到自已要的功能所以寫那一些方法在Run。 syntan大大說的,自已再去研究一下...
------
初學、初學、學了很久...還是在初學階段..Orz |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |