unit URLGrabberMainForm;
interface
uses
{$IFDEF LINUX}
SysUtils, Classes, QGraphics, QForms, QDialogs, QStdCtrls, QExtCtrls,
QControls, QComCtrls,
{$ENDIF}
{$IFDEF WIN32}
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls,
{$ENDIF}
JNI;
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_args: JavaVMInitArgs;
// If using j2sdk v1.4, enable this define.
// If using j2sdk v1.2 or v1.3, disable the define
{.$DEFINE USING_J2SDK1_4}
{$IFNDEF USING_J2SDK1_4}
VM_args11: JDK1_1InitArgs;
Classpath: string;
{$ENDIF}
Options: array [0..10] of JavaVMOption;
begin
UpdateStatusBar('Loading VM...', True);
try
// Create the wrapper for the VM
FJavaVM := TJavaVM.Create;
{$IFNDEF USING_J2SDK1_4}
// Get default settings (so we can display them)
// This doesn't work with 1.4 and I don't know why.
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);
{$ENDIF}
// Set up the options for the VM
FillChar(Options, SizeOf(Options), #0);
Options[0].optionString := '-Djava.class.path=.';
{$IFDEF USING_J2SDK1_4}
VM_args.version := JNI_VERSION_1_4;
{$ELSE}
VM_args.version := JNI_VERSION_1_2;
{$ENDIF}
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.