⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 urlgrabbermainform_pas.html

📁 JNI(java本地接口)之delphi版
💻 HTML
字号:
🔍 
<html>
<body BGCOLOR="#e0e0e0">
<pre class="sourcecode"><code>
<b>unit</b> URLGrabberMainForm;

<b>interface</b>

<b>uses</b>
  <font color="#003399"><i>{$IFDEF LINUX}</i></font>
  SysUtils, Classes, QGraphics, QForms, QDialogs, QStdCtrls, QExtCtrls,
  QControls, QComCtrls,
  JNI;
  <font color="#003399"><i>{$ENDIF}</i></font>

  <font color="#003399"><i>{$IFDEF WIN32}</i></font>
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls,
  JNI;
  <font color="#003399"><i>{$ENDIF}</i></font>

<b>type</b>
  TURLThread = <b>class</b>(TThread)
  <b>public</b>
    URL: <b>string</b>;
    HTML: <b>string</b>;
    JavaVM: TJavaVM;
    <b>constructor</b> Create(<b>const</b> JavaVM: TJavaVM; <b>const</b> URL: <b>string</b>);
    <b>procedure</b> Execute; <b>override</b>;
    <b>procedure</b> UpdateUI;
  <b>end</b>;

  TURLGrabberForm = <b>class</b>(TForm)
    mmoHTML: TMemo;
    btnLoadVM: TButton;
    lblURLs: TLabel;
    lstURLs: TComboBox;
    btnCallClassMethod: TButton;
    btnCallMethodFromThread: TButton;
    btnCallObjectMethod: TButton;
    btnCreateMultipleThreads: TButton;
    barStatus: TStatusBar;
    <b>procedure</b> FormDestroy(Sender: TObject);
    <b>procedure</b> btnCallClassMethodClick(Sender: TObject);
    <b>procedure</b> btnLoadVMClick(Sender: TObject);
    <b>procedure</b> btnCallObjectMethodClick(Sender: TObject);
    <b>procedure</b> btnCallMethodFromThreadClick(Sender: TObject);
    <b>procedure</b> btnCreateMultipleThreadsClick(Sender: TObject);
  <b>private</b>
    FJavaVM: TJavaVM;
    FJNIEnv: TJNIEnv;
    <b>procedure</b> UpdateStatusBar(<b>const</b> Text: <b>string</b>; ClearMemo: Boolean = False);
  <b>end</b>;

<b>var</b>
  URLGrabberForm: TURLGrabberForm;

<b>implementation</b>

<font color="#003399"><i>{$IFDEF LINUX}</i></font>
<font color="#003399"><i>{$R *.xfm}</i></font>
<font color="#003399"><i>{$ENDIF}</i></font>
<font color="#003399"><i>{$IFDEF WIN32}</i></font>
<font color="#003399"><i>{$R *.dfm}</i></font>
<font color="#003399"><i>{$ENDIF}</i></font>

<b>function</b> CreateJavaObject(<b>const</b> JNIEnv: TJNIEnv; <b>const</b> ClassName: <b>string</b>; <b>var</b> AClass: JClass): JObject;
<b>var</b>
  Mid: JMethodID;
<b>begin</b>
  Result := <b>nil</b>;

    <font color="#003399"><i>// Find the class</i></font>
  <b>try</b>
    AClass := JNIEnv.FindClass(PChar(ClassName));
    <b>if</b> AClass = <b>nil</b> <b>then</b>
      Exit;

      <font color="#003399"><i>// Get its default constructor</i></font>
    Mid := JNIEnv.GetMethodID(AClass, <font color="#9933CC">'&lt;init&gt;'</font>, <font color="#9933CC">'()V'</font>);
    <b>if</b> Mid = <b>nil</b> <b>then</b>
      Exit;

      <font color="#003399"><i>// Create the object</i></font>
    Result := JNIEnv.NewObjectA(AClass, Mid, <b>nil</b>);

  <b>except</b>
    <b>on</b> E: Exception <b>do</b>
      ShowMessage(<font color="#9933CC">'Error: '</font> + E.Message);
  <b>end</b>;
<b>end</b>;

<b>procedure</b> TURLGrabberForm.FormDestroy(Sender: TObject);
<b>begin</b>
  FJNIEnv.Free;
  FJavaVM.Free;
<b>end</b>;

<b>procedure</b> TURLGrabberForm.btnLoadVMClick(Sender: TObject);
<b>var</b>
  Errcode: Integer;
  VM_args11: JDK1_1InitArgs;
  VM_args: JavaVMInitArgs;
  Classpath: <b>string</b>;
  Options: <b>array</b> [0..10] <b>of</b> JavaVMOption;
<b>begin</b>
  UpdateStatusBar(<font color="#9933CC">'Loading VM...'</font>, True);

  <b>try</b>
      <font color="#003399"><i>// Create the wrapper for the VM</i></font>
    FJavaVM := TJavaVM.Create;

      <font color="#003399"><i>// Get default settings (so we can display them)</i></font>
    Errcode := JNI_GetDefaultJavaVMInitArgs(@VM_args11);
    <b>if</b> Errcode &lt; 0 <b>then</b>
    <b>begin</b>
      ShowMessageFmt(<font color="#9933CC">'JNI_GetDefaultJavaVMInitArgs failed, error code = %d'</font>, [Errcode]);
      Exit;
    <b>end</b>;

      <font color="#003399"><i>// Display the classpath (this is just for reference)</i></font>
    Classpath := VM_args11.classpath;
    mmoHTML.Lines.Add(<font color="#9933CC">'CLASSPATH='</font> + Classpath);

      <font color="#003399"><i>// Set up the options for the VM</i></font>
    FillChar(Options, SizeOf(Options), #0);
    Options[0].optionString := <font color="#9933CC">'-Djava.class.path=.'</font>;
    VM_args.version := JNI_VERSION_1_2;
    VM_args.options := @Options;
    VM_args.nOptions := 1;

      <font color="#003399"><i>// Load the VM</i></font>
    Errcode := FJavaVM.LoadVM(VM_args);
    <b>if</b> Errcode &lt; 0 <b>then</b>
    <b>begin</b>
        <font color="#003399"><i>// Loading the VM more than once will cause this error</i></font>
      <b>if</b> Errcode = JNI_EEXIST <b>then</b>
        MessageDlg(<font color="#9933CC">'Java VM has already been loaded. Only one VM can be loaded.'</font>, mtError, [mbOK], 0)
      <b>else</b>
        ShowMessageFmt(<font color="#9933CC">'Error creating JavaVM, code = %d'</font>, [Errcode]);
      Exit;
    <b>end</b>;

      <font color="#003399"><i>// Create the Env class</i></font>
    FJNIEnv := TJNIEnv.Create(FJavaVM.Env);

      <font color="#003399"><i>// Enable UI buttons</i></font>
    btnCallClassMethod.Enabled := True;
    btnCallObjectMethod.Enabled := True;
    btnCallMethodFromThread.Enabled := True;
    btnCreateMultipleThreads.Enabled := True;

  <b>except</b>
    <b>on</b> E: Exception <b>do</b>
    <b>begin</b>
      ShowMessage(<font color="#9933CC">'Error: '</font> + E.Message);
      UpdateStatusBar(<font color="#9933CC">'Load VM failed.'</font>);
      Exit;
    <b>end</b>;
  <b>end</b>;

  UpdateStatusBar(<font color="#9933CC">'Ready.'</font>);
<b>end</b>;

<b>procedure</b> TURLGrabberForm.btnCallClassMethodClick(Sender: TObject);
<b>var</b>
  Cls: JClass;
  Mid: JMethodID;
  HTML: <b>string</b>;
  URL: <b>string</b>;
  JStr: JString;
<b>begin</b>
  UpdateStatusBar(<font color="#9933CC">'Calling class method...'</font>, True);

  <b>try</b>
      <font color="#003399"><i>// Get the URL from the UI</i></font>
    URL := lstURLs.Text;

      <font color="#003399"><i>// Find PageGrabber class</i></font>
    Cls := FJNIEnv.FindClass(<font color="#9933CC">'PageGrabber'</font>);
    <b>if</b> Cls = <b>nil</b> <b>then</b>
    <b>begin</b>
      ShowMessage(<font color="#9933CC">'Can'</font><font color="#9933CC">'t find class: PageGrabber'</font>);
      Exit;
    <b>end</b>;

      <font color="#003399"><i>// Locate static method 'FetchS' in class</i></font>
    Mid := FJNIEnv.GetStaticMethodID(Cls, <font color="#9933CC">'FetchS'</font>, <font color="#9933CC">'(Ljava/lang/String;)Ljava/lang/String;'</font>);
    <b>if</b> Mid = <b>nil</b> <b>then</b>
    <b>begin</b>
      ShowMessage(<font color="#9933CC">'Can'</font><font color="#9933CC">'t find method: FetchS'</font>);
      Exit;
    <b>end</b>;

      <font color="#003399"><i>// Call the static method</i></font>
    JStr := FJNIEnv.CallStaticObjectMethod(Cls, Mid, [URL]);

      <font color="#003399"><i>// Convert the returned JString to a Delphi string</i></font>
    HTML := FJNIEnv.JStringToString(JStr);

      <font color="#003399"><i>// Display the HTML</i></font>
    mmoHTML.Lines.Add(HTML);

  <b>except</b>
    <b>on</b> E: Exception <b>do</b>
      ShowMessage(<font color="#9933CC">'Error: '</font> + E.Message);
  <b>end</b>;

  UpdateStatusBar(<font color="#9933CC">'Ready.'</font>);
<b>end</b>;

<b>procedure</b> TURLGrabberForm.btnCallObjectMethodClick(Sender: TObject);
<b>var</b>
  Cls: JClass;
  Mid: JMethodID;
  PageGrabber: JObject;
  JStr: JString;
  URL, HTML: <b>string</b>;
<b>begin</b>
  UpdateStatusBar(<font color="#9933CC">'Calling object method...'</font>, True);

  <b>try</b>
      <font color="#003399"><i>// Get the URL from the UI</i></font>
    URL := lstURLs.Text;

      <font color="#003399"><i>// Construct PageGrabber object</i></font>
    PageGrabber := CreateJavaObject(FJNIEnv, <font color="#9933CC">'PageGrabber'</font>, Cls);
    <b>if</b> PageGrabber = <b>nil</b> <b>then</b>
    <b>begin</b>
      ShowMessage(<font color="#9933CC">'Can'</font><font color="#9933CC">'t create PageGrabber object'</font>);
      Exit;
    <b>end</b>;

      <font color="#003399"><i>// Locate the 'Fetch' method</i></font>
    Mid := FJNIEnv.GetMethodID(Cls, <font color="#9933CC">'Fetch'</font>, <font color="#9933CC">'(Ljava/lang/String;)Ljava/lang/String;'</font>);
    <b>if</b> Mid = <b>nil</b> <b>then</b>
    <b>begin</b>
      ShowMessage(<font color="#9933CC">'Can'</font><font color="#9933CC">'t find method: Fetch'</font>);
      Exit;
    <b>end</b>;

      <font color="#003399"><i>// Call the method</i></font>
    JStr := FJNIEnv.CallObjectMethod(PageGrabber, Mid, [URL]);

      <font color="#003399"><i>// Convert the returned JString to a Delphi string</i></font>
    HTML := FJNIEnv.JStringToString(JStr);

      <font color="#003399"><i>// Display the HTML</i></font>
    mmoHTML.Lines.Add(HTML);

  <b>except</b>
    <b>on</b> E: Exception <b>do</b>
      ShowMessage(<font color="#9933CC">'Error: '</font> + E.Message);
  <b>end</b>;

  UpdateStatusBar(<font color="#9933CC">'Ready.'</font>);
<b>end</b>;

<b>procedure</b> TURLGrabberForm.btnCallMethodFromThreadClick(Sender: TObject);
<b>var</b>
  URLThread: TURLThread;
  URL: <b>string</b>;
<b>begin</b>
  mmoHTML.Clear;
  Application.ProcessMessages;
  URL := lstURLs.Text;
  URLThread := TURLThread.Create(FJavaVM, URL);
  URLThread.Resume;
<b>end</b>;

<b>procedure</b> TURLGrabberForm.btnCreateMultipleThreadsClick(Sender: TObject);
<b>var</b>
  URLThread: TURLThread;
  I: Integer;
  URL: <b>string</b>;
<b>begin</b>
  UpdateStatusBar(<font color="#9933CC">'Creating threads...'</font>, True);

    <font color="#003399"><i>// Create a thread for each URL in the list</i></font>
  <b>for</b> I := 0 <b>to</b> lstURLs.Items.Count - 1 <b>do</b>
  <b>begin</b>
    URL := lstURLs.Items[I];
    URLThread := TURLThread.Create(FJavaVM, URL);
    URLThread.Resume;
  <b>end</b>;

  UpdateStatusBar(<font color="#9933CC">'Ready.'</font>);
<b>end</b>;

<b>procedure</b> TURLGrabberForm.UpdateStatusBar(<b>const</b> Text: <b>string</b>; ClearMemo: Boolean);
<b>begin</b>
  <b>if</b> ClearMemo <b>then</b>
    mmoHTML.Lines.Clear;
  barStatus.Panels[0].Text := Text;
  Application.ProcessMessages;
<b>end</b>;

<font color="#003399"><i>//****************************************************************************</i></font>
<font color="#003399"><i>// TURLThread</i></font>
<font color="#003399"><i>//****************************************************************************</i></font>

<b>constructor</b> TURLThread.Create(<b>const</b> JavaVM: TJavaVM; <b>const</b> URL: <b>string</b>);
<b>begin</b>
  <b>inherited</b> Create(True);
  Self.URL := URL;
  Self.JavaVM := JavaVM;
  HTML := <font color="#9933CC">''</font>;
<b>end</b>;

<b>procedure</b> TURLThread.UpdateUI;
<b>begin</b>
  <b>with</b> URLGrabberForm.mmoHTML.Lines <b>do</b>
  <b>begin</b>
    Add(StringOfChar(<font color="#9933CC">'*'</font>, 80));
    Add(URL);
    Add(StringOfChar(<font color="#9933CC">'*'</font>, 80));
    Add(HTML);
  <b>end</b>;
<b>end</b>;

<b>procedure</b> TURLThread.Execute;
<b>var</b>
  Cls: JClass;
  Mid: JMethodID;
  PageGrabber: JObject;
  RetVal: JString;
  Env: PJNIEnv;
  JNIEnv: TJNIEnv;
<b>begin</b>

  <b>try</b>
      <font color="#003399"><i>// Attach this thread to the running JVM</i></font>
    JavaVM.JavaVM^.AttachCurrentThread(JavaVM.JavaVM, @Env, <b>nil</b>);

      <font color="#003399"><i>// Create the TJNIEnv wrapper class from the environment just retrieved</i></font>
    JNIEnv := TJNIEnv.Create(Env);

      <font color="#003399"><i>// Create an instance of the PageGrabber Java object</i></font>
    PageGrabber := CreateJavaObject(JNIEnv, <font color="#9933CC">'PageGrabber'</font>, Cls);

      <font color="#003399"><i>// Locate the method we wish to call</i></font>
    Mid := JNIEnv.GetMethodID(Cls, <font color="#9933CC">'Fetch'</font>, <font color="#9933CC">'(Ljava/lang/String;)Ljava/lang/String;'</font>);
    <b>if</b> Mid = <b>nil</b> <b>then</b>
    <b>begin</b>
      ShowMessage(<font color="#9933CC">'Can'</font><font color="#9933CC">'t find method: Fetch'</font>);
      Exit;
    <b>end</b>;

      <font color="#003399"><i>// Call the method</i></font>
    RetVal := JNIEnv.CallObjectMethod(PageGrabber, Mid, [URL]);

      <font color="#003399"><i>// Convert the JString to a Delphi string</i></font>
    HTML := JNIEnv.JStringToString(RetVal);

      <font color="#003399"><i>// This will display the HTML in a &quot;safe&quot; manner</i></font>
    Synchronize(UpdateUI);

      <font color="#003399"><i>// Release the reference to this thread (important!)</i></font>
    JavaVM.JavaVM^.DetachCurrentThread(JavaVM.JavaVM);

  <b>except</b>
    <b>on</b> E: Exception <b>do</b>
      ShowMessage(<font color="#9933CC">'Error: '</font> + E.Message);
  <b>end</b>;
<b>end</b>;

<b>end</b>.

</code></pre></body>
</html>

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -