不知道要如何將這個程式,改成函數可以提供呼叫 |
答題得分者是:Stallion
|
g9221712
高階會員 發表:145 回覆:344 積分:162 註冊:2006-07-06 發送簡訊給我 |
各位前輩及版主大大:
我在網路上看到一個取得實體ip的程式,但是我想將這個程式改成函數可以呼叫, 不知道要怎樣改比較快! 我看了一下程式,是透過外部的網頁,取得實體ip,但是需要解析html內容, 我想改成String來取代memo物件,因為想改成Function Call 不想在開啟網頁, 不知道要怎麼改寫!懇請各位前輩給予提示! // Program : 取得真實 Internent IP ( 未必是本機 IP ) // Compiler : Delphi 7 Enterprise unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP; type TForm1 = class(TForm) Memo1: TMemo; Edit1: TEdit; IdHTTP1: TIdHTTP; procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); var i: Integer; j, k, m: Integer; addr: array[1..4] of string; begin { 查真實 Internet IP 網址 http: //myipaddress.com/show-my-ip-address/ http: //www.danasoft.com/ http: //ipid.shat.net/ http: //www.whatismyip.com/ } // Memo1.WordWrap := False; // 不換行 IdHTTP1.HandleRedirects := true; Memo1.Text := IdHTTP1.Get('http://ipid.shat.net/'); // Memo1.Text := IdHTTP1.Get('http://www.kost.com.tw/ip.asp'); 因為網頁格式不同,會導致擷取失敗 k := 1; for i := 0 to Memo1.Lines.Count - 1 do begin if k < 5 then for j := 1 to Length(Memo1.Lines[i]) do begin // 找 .<!-- if (Memo1.Lines[i][j] = '.') and (Memo1.Lines[i][j 1] = '<') and (Memo1.Lines[i][j 2] = '!') and (Memo1.Lines[i][j 3] = '-') and (Memo1.Lines[i][j 4] = '-') then begin if Memo1.Lines[i][j - 2] = '>' then Addr[k] := Memo1.Lines[i][j - 1]; if Memo1.Lines[i][j - 3] = '>' then Addr[k] := Memo1.Lines[i][j - 2] Memo1.Lines[i][j - 1]; if Memo1.Lines[i][j - 4] = '>' then Addr[k] := Memo1.Lines[i][j - 3] Memo1.Lines[i][j - 2] Memo1.Lines[i][j - 1]; k := k 1; end; if k = 4 then begin if (Memo1.Lines[i][j] = '>') and (Memo1.Lines[i][j 2] = '<') then begin Addr[4] := Memo1.Lines[i][j 1]; k := k 1; end; if (Memo1.Lines[i][j] = '>') and (Memo1.Lines[i][j 3] = '<') then begin Addr[4] := Memo1.Lines[i][j 1] Memo1.Lines[i][j 2]; k := k 1; end; if (Memo1.Lines[i][j] = '>') and (Memo1.Lines[i][j 4] = '<') then begin Addr[4] := Memo1.Lines[i][j 1] Memo1.Lines[i][j 2] Memo1.Lines[i][j 3]; k := k 1; end; end; end; end; Edit1.text := Addr[1] '.' Addr[2] '.' Addr[3] '.' Addr[4]; Memo1.Visible:=False; Form1.Height:=80; Form1.Width:=150; end; end.
------
「人們所以覺得寂寞,是因為他們會築牆,卻不會搭橋。」 程式寫的越久,卻發現自己越來越不會寫程式! |
Stallion
版主 發表:52 回覆:1600 積分:1995 註冊:2004-09-15 發送簡訊給我 |
|
g9221712
高階會員 發表:145 回覆:344 積分:162 註冊:2006-07-06 發送簡訊給我 |
|
pcboy
版主 發表:177 回覆:1838 積分:1463 註冊:2004-01-13 發送簡訊給我 |
你可以用 String 代替 Memo 取得回傳網頁的 Source Code 沒問題
找出靠近 IP 的的 唯一字串, 開始向後進行分析, 找出真正的 IP 文字 ****************************** 那個程式是小弟寫的啦 ~ 重點關鍵 1. 找一個會顯示你 Internet IP 的網站 2. 取得回傳網頁的 Source Code 3. Source Code 中必須包含你的 IP (某些網頁的 IP 不是文字直接顯示, 這種網站就沒用了) 4. 找出靠近 IP 的的 唯一字串, 開始向後進行分析, 找出真正的 IP 文字 (這是要花腦筋去想的地方, 處理方式見人見智)
------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案! 子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問! |
pcboy
版主 發表:177 回覆:1838 積分:1463 註冊:2004-01-13 發送簡訊給我 |
用 String 代替 Memo1 的程式
procedure FormCreate(Sender: TObject); var j, k : Integer; addr: array[1..4] of string; SS : String; begin IdHTTP1.HandleRedirects := true; ss := IdHTTP1.Get('http://ipid.shat.net/'); k := 1; for j := 0 to Length(SS) - 8000 do begin if k < 5 then begin // 找 . if (SS[j] = '.') and (SS[j 1] = '<') and (SS[j 2] = '!') and (SS[j 3] = '-') and (SS[j 4] = '-') then begin if SS[j - 2] = '>' then Addr[k] := SS[j - 1]; if SS[j - 3] = '>' then Addr[k] := SS[j - 2] SS[j - 1]; if SS[j - 4] = '>' then Addr[k] := SS[j - 3] SS[j - 2] SS[j - 1]; k := k 1; end; if k = 4 then begin if (SS[j] = '>') and (SS[j 2] = '<') then begin Addr[4] := SS[j 1]; k := k 1; end; if (SS[j] = '>') and (SS[j 3] = '<') then begin Addr[4] := SS[j 1] SS[j 2]; k := k 1; end; if (SS[j] = '>') and (SS[j 4] = '<') then begin Addr[4] := SS[j 1] SS[j 2] SS[j 3]; k := k 1; end; end; end; end; Edit1.Text := Addr[1] '.' Addr[2] '.' Addr[3] '.' Addr[4]; end;
------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案! 子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問! |
pcboy
版主 發表:177 回覆:1838 積分:1463 註冊:2004-01-13 發送簡訊給我 |
改成 function 時候失敗, 小弟無力解決, IdHTTP1 不能用在 function 中 ? 還是該怎樣宣告 ? 看是否有人能幫忙解決
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, StdCtrls; type TForm1 = class(TForm) Edit1: TEdit; IdHTTP1: TIdHTTP; procedure FormCreate(Sender: TObject); // function GetInternetIP : String; private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} function GetInternetIP : String; forward; procedure TForm1.FormCreate(Sender: TObject); begin Edit1.Text:= GetInternetIP; end; function GetInternetIP : String; var j, k : Integer; addr: array[1..4] of string; SS : String; begin IdHTTP1.HandleRedirects := true; // 發生 Undeclared identifier: 'IdHTTP1' 錯誤, 期待高手解決 ss := IdHTTP1.Get('http://ipid.shat.net/'); k := 1; for j := 0 to Length(SS) - 8000 do begin if k < 5 then begin // 找 . if (SS[j] = '.') and (SS[j 1] = '<') and (SS[j 2] = '!') and (SS[j 3] = '-') and (SS[j 4] = '-') then begin if SS[j - 2] = '>' then Addr[k] := SS[j - 1]; if SS[j - 3] = '>' then Addr[k] := SS[j - 2] SS[j - 1]; if SS[j - 4] = '>' then Addr[k] := SS[j - 3] SS[j - 2] SS[j - 1]; k := k 1; end; if k = 4 then begin if (SS[j] = '>') and (SS[j 2] = '<') then begin Addr[4] := SS[j 1]; k := k 1; end; if (SS[j] = '>') and (SS[j 3] = '<') then begin Addr[4] := SS[j 1] SS[j 2]; k := k 1; end; if (SS[j] = '>') and (SS[j 4] = '<') then begin Addr[4] := SS[j 1] SS[j 2] SS[j 3]; k := k 1; end; end; end; end; Result := Addr[1] '.' Addr[2] '.' Addr[3] '.' Addr[4]; end; end.
------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案! 子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問! |
Stallion
版主 發表:52 回覆:1600 積分:1995 註冊:2004-09-15 發送簡訊給我 |
PCBoy2不好意思~借花獻佛。
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, StrUtils; type TTestForm = class(TForm) ShowInternetIPButton: TButton; FindIPIdHTTP: TIdHTTP; procedure ShowInternetIPButtonClick(Sender: TObject); private { Private declarations } public { Public declarations } function GetInternetIP:String; end; var TestForm: TTestForm; implementation {$R *.dfm} function TTestForm.GetInternetIP:String; var aTempString:String; Index1,Index2:integer; begin Self.FindIPIdHTTP.HandleRedirects := true; aTempString := Self.FindIPIdHTTP.Get('http://www.whatismyip.com/'); Index1 := Pos(' < h1 >Your IP Is',aTempString); if ( Index1 = 0 ) then Result := 'Not Found!' else begin Index2 := PosEX('< /h1 >',aTempString,Index1 Length('< h1 >Your IP Is')); if ( Index2 = 0 ) then Result := 'Not Found!' else Result := MidBStr(aTempString,Index1 Length('< h1 >Your IP Is'),Index2-(Index1 Length('< h1 >Your IP Is'))); end; end; procedure TTestForm.ShowInternetIPButtonClick(Sender: TObject); begin ShowMessage(Self.GetInternetIP); end; end. 程式碼中的HTML標籤我故意把他分開一點,否則內容會被討論區翻譯,我不知道要如何在討論區內把程式碼的HTML標籤顯示出來,所以程式碼中的HTML標籤在貼回程式時,請注意還原。 還有~你的範例程式中IDHTTP之所以錯誤是因為你在獨立的GetInternetIP函數中去使用TForm裏面的IDHTTP元件,COMPILER當然不知道那是啥?!比對小弟改寫的你就看出來了! 如果要把取得IP的函數獨立於類別之外,那麼在獨立的函數內要單獨宣告一個TIDHTTP,然後把他CREATE起來,用完後再把它FREE掉。 |
g9221712
高階會員 發表:145 回覆:344 積分:162 註冊:2006-07-06 發送簡訊給我 |
Stallion和pcboy2 兩位前輩:
感謝pcboy2 不斷的測試和測試修改,也感謝Stallion給予回應和正確的解答! 但是我還有一個問題,雖然我的問題已經獲得解決!但是我因為我害怕 http://www.whatismyip.com/ 若倒站,會導致解析網址的程式瓦解失效, 不知道是否有更穩定的方式,取得WAN的實體ip?我很怕我自己的程式 只能用一時,尤其外部網站的穩定度,不是自己可以控制的! 不過還是要再次感謝Stallion和pcboy2 兩位前輩,謝謝您!
------
「人們所以覺得寂寞,是因為他們會築牆,卻不會搭橋。」 程式寫的越久,卻發現自己越來越不會寫程式! |
Stallion
版主 發表:52 回覆:1600 積分:1995 註冊:2004-09-15 發送簡訊給我 |
|
pcboy
版主 發表:177 回覆:1838 積分:1463 註冊:2004-01-13 發送簡訊給我 |
|
pcboy
版主 發表:177 回覆:1838 積分:1463 註冊:2004-01-13 發送簡訊給我 |
有辦法連 procedure ShowInternetIPButtforbidden(Sender: TObject); 也省略嗎 ?
依您所說測試了一下仍失敗, 可否再指點一下 type TForm1 = class(TForm) Edit1: TEdit; IdHTTP1: TIdHTTP; procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; function GetInternetIP: String; var // ... (略) IdHTTP1x: TIdHTTP; begin IdHTTP1x.Create(Form1); // 錯誤 Variable 'IdHTTP1x' might not have been initialized // ... (略) IdHTTP1x.Free end;
------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案! 子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問! |
pcboy
版主 發表:177 回覆:1838 積分:1463 註冊:2004-01-13 發送簡訊給我 |
還是失敗
type TForm1 = class(TForm) Edit1: TEdit; IdHTTP1: TIdHTTP; procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } // function GetInternetIP:String; end; function GetInternetIP: String; var // ... (略) IdHTTP1: TIdHTTP; begin IdHTTP1.Create(Form1); // 錯誤 Project Project1.exe raised exception class EAcessViolation with message 'Access Violation at address 00467E4A in module //'Project1.exe'. Read of 00000A06. Process stopped. Use Step or Run to continue // ... (略) IdHTTP1.Free end;
------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案! 子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問! |
Stallion
版主 發表:52 回覆:1600 積分:1995 註冊:2004-09-15 發送簡訊給我 |
unit Unit1;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, StrUtils; type TTestForm = class(TForm) ShowInternetIPButton: TButton; procedure ShowInternetIPButtonClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var TestForm: TTestForm; implementation {$R *.dfm} function GetInternetIP:String; var FindIPIdHTTP:TIdHTTP; aTempString:String; Index1,Index2:integer; begin try FindIPIdHTTP := TIdHTTP.Create(nil); FindIPIdHTTP.HandleRedirects := true; aTempString := FindIPIdHTTP.Get('http://www.whatismyip.com/'); Index1 := Pos('< h1 >Your IP Is',aTempString); if ( Index1 = 0 ) then Result := 'Not Found!' else begin Index2 := PosEX('< /h1 >',aTempString,Index1 Length('< h1 >Your IP Is')); if ( Index2 = 0 ) then Result := 'Not Found!' else Result := MidBStr(aTempString,Index1 Length('< h1 >Your IP Is'),Index2-(Index1 Length('< h1 >Your IP Is'))); end; finally FindIPIdHTTP.Free; end; end; procedure TTestForm.ShowInternetIPButtonClick(Sender: TObject); begin ShowMessage(GetInternetIP); end; 建議PCBoy2兄,再參考一下類別的定義與規則,這樣運用或自訂類別比較自如。 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |