請教各位先進，因錯誤實在查不出為什麼所以看大家是否有遇過 |
|
答題得分者是：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 |
發表時間：2007-11-27 10:30:15
IP:59.127.xxx.xxx 訂閱
系統時間：2024-04-19 17:03:24
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |