unit URLGrabberMainForm;

interface

uses
  {$IFDEF LINUX}
  SysUtils, Classes, QGraphics, QForms, QDialogs, QStdCtrls, QExtCtrls,
  QControls, QComCtrls,
  JNI;
  {$ENDIF}

  {$IFDEF WIN32}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls,
  JNI;
  {$ENDIF}

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

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

var
  URLGrabberForm: TURLGrabberForm;

implementation

{$IFDEF LINUX}
{$R *.xfm}
{$ENDIF}
{$IFDEF WIN32}
{$R *.dfm}
{$ENDIF}

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

    // Find the class
  try
    AClass := JNIEnv.FindClass(PChar(ClassName));
    if AClass = nil then
      Exit;

      // Get its default constructor
    Mid := JNIEnv.GetMethodID(AClass, '<init>', '()V');
    if Mid = nil then
      Exit;

      // Create the object
    Result := JNIEnv.NewObjectA(AClass, Mid, nil);

  except
    on E: Exception do
      ShowMessage('Error: ' + E.Message);
  end;
end;

procedure TURLGrabberForm.FormDestroy(Sender: TObject);
begin
  FJNIEnv.Free;
  FJavaVM.Free;
end;

procedure TURLGrabberForm.btnLoadVMClick(Sender: TObject);
var
  Errcode: Integer;
  VM_args11: JDK1_1InitArgs;
  VM_args: JavaVMInitArgs;
  Classpath: string;
  Options: array [0..10] of JavaVMOption;
begin
  UpdateStatusBar('Loading VM...', True);

  try
      // Create the wrapper for the VM
    FJavaVM := TJavaVM.Create;

      // Get default settings (so we can display them)
    Errcode := JNI_GetDefaultJavaVMInitArgs(@VM_args11);
    if Errcode < 0 then
    begin
      ShowMessageFmt('JNI_GetDefaultJavaVMInitArgs failed, error code = %d', [Errcode]);
      Exit;
    end;

      // Display the classpath (this is just for reference)
    Classpath := VM_args11.classpath;
    mmoHTML.Lines.Add('CLASSPATH=' + Classpath);

      // Set up the options for the VM
    FillChar(Options, SizeOf(Options), #0);
    Options[0].optionString := '-Djava.class.path=.';
    VM_args.version := JNI_VERSION_1_2;
    VM_args.options := @Options;
    VM_args.nOptions := 1;

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

      // Create the Env class
    FJNIEnv := TJNIEnv.Create(FJavaVM.Env);

      // Enable UI buttons
    btnCallClassMethod.Enabled := True;
    btnCallObjectMethod.Enabled := True;
    btnCallMethodFromThread.Enabled := True;
    btnCreateMultipleThreads.Enabled := True;

  except
    on E: Exception do
    begin
      ShowMessage('Error: ' + E.Message);
      UpdateStatusBar('Load VM failed.');
      Exit;
    end;
  end;

  UpdateStatusBar('Ready.');
end;

procedure TURLGrabberForm.btnCallClassMethodClick(Sender: TObject);
var
  Cls: JClass;
  Mid: JMethodID;
  HTML: string;
  URL: string;
  JStr: JString;
begin
  UpdateStatusBar('Calling class method...', True);

  try
      // Get the URL from the UI
    URL := lstURLs.Text;

      // Find PageGrabber class
    Cls := FJNIEnv.FindClass('PageGrabber');
    if Cls = nil then
    begin
      ShowMessage('Can''t find class: PageGrabber');
      Exit;
    end;

      // Locate static method 'FetchS' in class
    Mid := FJNIEnv.GetStaticMethodID(Cls, 'FetchS', '(Ljava/lang/String;)Ljava/lang/String;');
    if Mid = nil then
    begin
      ShowMessage('Can''t find method: FetchS');
      Exit;
    end;

      // Call the static method
    JStr := FJNIEnv.CallStaticObjectMethod(Cls, Mid, [URL]);

      // Convert the returned JString to a Delphi string
    HTML := FJNIEnv.JStringToString(JStr);

      // Display the HTML
    mmoHTML.Lines.Add(HTML);

  except
    on E: Exception do
      ShowMessage('Error: ' + E.Message);
  end;

  UpdateStatusBar('Ready.');
end;

procedure TURLGrabberForm.btnCallObjectMethodClick(Sender: TObject);
var
  Cls: JClass;
  Mid: JMethodID;
  PageGrabber: JObject;
  JStr: JString;
  URL, HTML: string;
begin
  UpdateStatusBar('Calling object method...', True);

  try
      // Get the URL from the UI
    URL := lstURLs.Text;

      // Construct PageGrabber object
    PageGrabber := CreateJavaObject(FJNIEnv, 'PageGrabber', Cls);
    if PageGrabber = nil then
    begin
      ShowMessage('Can''t create PageGrabber object');
      Exit;
    end;

      // Locate the 'Fetch' method
    Mid := FJNIEnv.GetMethodID(Cls, 'Fetch', '(Ljava/lang/String;)Ljava/lang/String;');
    if Mid = nil then
    begin
      ShowMessage('Can''t find method: Fetch');
      Exit;
    end;

      // Call the method
    JStr := FJNIEnv.CallObjectMethod(PageGrabber, Mid, [URL]);

      // Convert the returned JString to a Delphi string
    HTML := FJNIEnv.JStringToString(JStr);

      // Display the HTML
    mmoHTML.Lines.Add(HTML);

  except
    on E: Exception do
      ShowMessage('Error: ' + E.Message);
  end;

  UpdateStatusBar('Ready.');
end;

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

procedure TURLGrabberForm.btnCreateMultipleThreadsClick(Sender: TObject);
var
  URLThread: TURLThread;
  I: Integer;
  URL: string;
begin
  UpdateStatusBar('Creating threads...', True);

    // Create a thread for each URL in the list
  for I := 0 to lstURLs.Items.Count - 1 do
  begin
    URL := lstURLs.Items[I];
    URLThread := TURLThread.Create(FJavaVM, URL);
    URLThread.Resume;
  end;

  UpdateStatusBar('Ready.');
end;

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

//****************************************************************************
// TURLThread
//****************************************************************************

constructor TURLThread.Create(const JavaVM: TJavaVM; const URL: string);
begin
  inherited Create(True);
  Self.URL := URL;
  Self.JavaVM := JavaVM;
  HTML := '';
end;

procedure TURLThread.UpdateUI;
begin
  with URLGrabberForm.mmoHTML.Lines do
  begin
    Add(StringOfChar('*', 80));
    Add(URL);
    Add(StringOfChar('*', 80));
    Add(HTML);
  end;
end;

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

  try
      // Attach this thread to the running JVM
    JavaVM.JavaVM^.AttachCurrentThread(JavaVM.JavaVM, @Env, nil);

      // Create the TJNIEnv wrapper class from the environment just retrieved
    JNIEnv := TJNIEnv.Create(Env);

      // Create an instance of the PageGrabber Java object
    PageGrabber := CreateJavaObject(JNIEnv, 'PageGrabber', Cls);

      // Locate the method we wish to call
    Mid := JNIEnv.GetMethodID(Cls, 'Fetch', '(Ljava/lang/String;)Ljava/lang/String;');
    if Mid = nil then
    begin
      ShowMessage('Can''t find method: Fetch');
      Exit;
    end;

      // Call the method
    RetVal := JNIEnv.CallObjectMethod(PageGrabber, Mid, [URL]);

      // Convert the JString to a Delphi string
    HTML := JNIEnv.JStringToString(RetVal);

      // This will display the HTML in a "safe" manner
    Synchronize(UpdateUI);

      // Release the reference to this thread (important!)
    JavaVM.JavaVM^.DetachCurrentThread(JavaVM.JavaVM);

  except
    on E: Exception do
      ShowMessage('Error: ' + E.Message);
  end;
end;

end.