Google
 

Sunday, November 22, 2009

Are we connected to the Internet?

Here's how to check whether you are connected to the Internet:

~~~~~~~~~~~~~~~~~~~~~~~~~procedure TForm1.Button1Click(Sender: TObject) ; function FuncAvail(_dllname, _funcname: string; var _p: pointer): boolean; {return True if _funcname exists in _dllname}
var _lib: tHandle;
begin
Result := false;
if LoadLibrary(PChar(_dllname)) = 0 then exit;
_lib := GetModuleHandle(PChar(_dllname)) ;
if _lib <> 0 then begin
_p := GetProcAddress(_lib, PChar(_funcname)) ;
if _p <> NIL then Result := true;
end;
end; { Call SHELL32.DLL for Win < Win98 otherwise call URL.dll }
{button code:}
var InetIsOffline : function(dwFlags: DWORD): BOOL;
stdcall;
begin
if FuncAvail('URL.DLL', 'InetIsOffline', @InetIsOffline) then
if InetIsOffLine(0) = true then
ShowMessage('Not connected')
else
ShowMessage('Connected!') ;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~

Wednesday, November 18, 2009

Numerical Entry Only On TEdit


If you want to limit the input of a TEdit to numerical strings only, you can discard the "invalid" characters in its OnKeyPress event handler.

Let's assume that you only want to allow positive integer numbers. The code for the OnKeyPress event handler is as follows:

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
// #8 is Backspace
if not (Key in [#8, '0'..'9']) then begin
ShowMessage('Invalid key');
// Discard the key
Key := #0;
end;
end;

If you also want numbers with a decimal fraction, you must allow a POINT or a COMMA, but only once. For an international version that looks at the correct decimal separator, the code could be as follows:

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in [#8, '0'..'9', DecimalSeparator]) then begin
ShowMessage('Invalid key: ' + Key);
Key := #0;
end
else if (Key = DecimalSeparator) and
(Pos(Key, Edit1.Text) > 0) then begin
ShowMessage('Invalid Key: twice ' + Key);
Key := #0;
end;
end;

And here's a full blown version of the event handler, accepting a decimal separator and negative numbers (minus sign: only accepted once, has to be the first character):

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in [#8, '0'..'9', '-', DecimalSeparator]) then
ShowMessage('Invalid key: ' + Key);
Key := #0;
end
else if ((Key = DecimalSeparator) or (Key = '-')) and
(Pos(Key, Edit1.Text) > 0) then begin
ShowMessage('Invalid Key: twice ' + Key);
Key := #0;
end
else if (Key = '-') and
(Edit1.SelStart <> 0) then begin
ShowMessage('Only allowed at beginning of number: ' + Key);
Key := #0;
end;
end;

How about giving that same behaviour to several TEdits on the same form, say 10 of them? In the Object Inspector, you change the name of the event handler of Edit1 from Edit1KeyPress to Edit1_10KeyPress or something similar. Delphi automatically changes the name in the code editor, don't worry.

Then, for each next TEdit, you select its OnKeyPress event and you select Edit1_10KeyPress from the listbox next to the event.

Finally, we have to slightly adapt the code. Intead of pointing to Edit1, we must point to "the TEdit that generated the event", in other words: the edit-box where the cursor was when a key was depressed. When you look at the template for the event handler that Delphi made, you see the parameter Sender: that's a pointer to the component that generated the event. But we are not allowed to use it straight away in our code, we must specify that we're dealing with a component of the type TEdit. That's done with the code Sender as TEdit:

procedure TForm1.Edit1_10KeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in [#8, '0'..'9', '-', DecimalSeparator]) then
ShowMessage('Invalid key: ' + Key);
Key := #0;
end
else if ((Key = DecimalSeparator) or (Key = '-')) and
(Pos(Key, (Sender as TEdit).Text) > 0) then begin
ShowMessage('Invalid Key: twice ' + Key);
Key := #0;
end
else if (Key = '-') and
((Sender as TEdit).SelStart <> 0) then begin
ShowMessage('Only allowed at beginning of number: ' + Key);
Key := #0;
end;
end;

Sunday, November 15, 2009

Get a list of computers in a network

type
PNetResourceArray = ^TNetResourceArray;
TNetResourceArray = array[0..100] of TNetResource;

function CreateNetResourceList(ResourceType: DWord;
NetResource: PNetResource;
out Entries: DWord;
out List: PNetResourceArray): Boolean;
var
EnumHandle: THandle;
BufSize: DWord;
Res: DWord;
begin
Result := False;
List := Nil;
Entries := 0;
if WNetOpenEnum(RESOURCE_GLOBALNET,
ResourceType,
0,
NetResource,
EnumHandle) = NO_ERROR then begin
try
BufSize := $4000; // 16 kByte
GetMem(List, BufSize);
try
repeat
Entries := DWord(-1);
FillChar(List^, BufSize, 0);
Res := WNetEnumResource(EnumHandle, Entries, List, BufSize);
if Res = ERROR_MORE_DATA then
begin
ReAllocMem(List, BufSize);
end;
until Res <> ERROR_MORE_DATA;
Result := Res = NO_ERROR;
if not Result then
begin
FreeMem(List);
List := Nil;
Entries := 0;
end;
except
FreeMem(List);
raise;
end;
finally
WNetCloseEnum(EnumHandle);
end;
end;
end;


procedure ScanNetworkResources(ResourceType, DisplayType: DWord; List: TStrings);

procedure ScanLevel(NetResource: PNetResource);
var
Entries: DWord;
NetResourceList: PNetResourceArray;
i: Integer;
begin
if CreateNetResourceList(ResourceType, NetResource, Entries, NetResourceList) then try
for i := 0 to Integer(Entries) - 1 do
begin
if (DisplayType = RESOURCEDISPLAYTYPE_GENERIC) or
(NetResourceList[i].dwDisplayType = DisplayType) then begin
List.AddObject(NetResourceList[i].lpRemoteName,
Pointer(NetResourceList[i].dwDisplayType));
end;
if (NetResourceList[i].dwUsage and RESOURCEUSAGE_CONTAINER) <> 0 then
ScanLevel(@NetResourceList[i]);
end;
finally
FreeMem(NetResourceList);
end;
end;
begin
ScanLevel(Nil);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
ScanNetworkResources(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER, ListBox1.Items);
end;

Friday, November 13, 2009

Langkah mudah untuk membuat Delphi chart

Gunakan langkahmudah berikut ini untuk memulai menggunakan Delphi TChart component:

  • Masukkan Komponen TChart kedalam form
  • Double Click pada chart lalu anda akan melihat dialog box.
  • Click tombol add idi series tab sheet.
  • Pilih Chart style pada daftar

Delphi chart

Put following code to add data into the chart

01.procedure TForm1.Button1Click(Sender: TObject);
02.begin
03. { function AddXY(Const AXValue, AYValue: Double;
04. Const AXLabel: String; AColor: TColor) : Longint;
05.
06. This function inserts a new point in the Series.
07. The new point has X and Y values. The AXLabel
08. parameter is optional (can be empty ''). The AColor
09. parameter is optional (can be clTeeColor).
10. The function returns the new point position in the
11. Values list. }
12. Chart1.Series[0].AddXY(10, 20, '', clTeeColor);
13. Chart1.Series[0].AddXY(15, 50, '', clTeeColor);
14. Chart1.Series[0].AddXY(20, 30, '', clTeeColor);
15. Chart1.Series[0].AddXY(25, 70, '', clTeeColor);
16. Chart1.Series[0].AddXY(30, 10, '', clTeeColor);
17. Chart1.Series[0].AddXY(35, 50, '', clTeeColor);
18. Chart1.Series[0].AddXY(40, 45, '', clTeeColor);
19. Chart1.Series[0].AddXY(45, 10, '', clTeeColor);
20.
21. { Or you can write following code using "With" statement.
22. Its much easier than repeating everything again and again.
23.
24. With Chart1.Series[0] Do
25. Begin
26. AddXY(10, 20, '', clTeeColor);
27. AddXY(15, 50, '', clTeeColor);
28. AddXY(20, 30, '', clTeeColor);
29. AddXY(25, 70, '', clTeeColor);
30. AddXY(30, 10, '', clTeeColor);
31. AddXY(35, 50, '', clTeeColor);
32. AddXY(40, 45, '', clTeeColor);
33. AddXY(45, 10, '', clTeeColor);
34. End;
35. }
36.end;

Wednesday, November 11, 2009

Mengirim Email dengan Delphi

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
edtSubject: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
edtNamaPengirim: TEdit;
edtEmailPengirim: TEdit;
Label4: TLabel;
edtNamaPenerima: TEdit;
edtEmailPenerima: TEdit;
Label5: TLabel;
MemoMessage: TMemo;
Label6: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses MAPI;

{$R *.dfm}

function SendMail(const Subject, Body, FileName,
SenderName, SenderEMail,
RecipientName, RecipientEMail: string): Integer;
var
Message: TMapiMessage;
lpSender, lpRecipient: TMapiRecipDesc;
FileAttach: TMapiFileDesc;
SM: TFNMapiSendMail;
MAPIModule: HModule;
begin
FillChar(Message, SizeOf(Message), 0);
with Message do
begin
if (Subject <> '') then
lpszSubject := PChar(Subject);
if (Body <> '') then
lpszNoteText := PChar(Body);
if (SenderEmail <> '') then
begin
lpSender.ulRecipClass := MAPI_ORIG;
if (SenderName = '') then
lpSender.lpszName := PChar(SenderEMail)
else
lpSender.lpszName := PChar(SenderName);
lpSender.lpszAddress := PChar(SenderEmail);
lpSender.ulReserved := 0;
lpSender.ulEIDSize := 0;
lpSender.lpEntryID := nil;
lpOriginator := @lpSender;
end;
if (RecipientEmail <> '') then
begin
lpRecipient.ulRecipClass := MAPI_TO;
if (RecipientName = '') then
lpRecipient.lpszName := PChar(RecipientEMail)
else
lpRecipient.lpszName := PChar(RecipientName);
lpRecipient.lpszAddress := PChar(RecipientEmail);
lpRecipient.ulReserved := 0;
lpRecipient.ulEIDSize := 0;
lpRecipient.lpEntryID := nil;
nRecipCount := 1;
lpRecips := @lpRecipient;
end
else lpRecips := nil;
if (FileName = '') then
begin
nFileCount := 0;
lpFiles := nil;
end
else
begin
FillChar(FileAttach, SizeOf(FileAttach), 0);
FileAttach.nPosition := Cardinal($FFFFFFFF);
FileAttach.lpszPathName := PChar(FileName);
nFileCount := 1;
lpFiles := @FileAttach;
end;
end;
MAPIModule := LoadLibrary(PChar(MAPIDLL));
if MAPIModule = 0 then
Result := -1
else
try
@SM := GetProcAddress(MAPIModule, 'MAPISendMail');
if @SM <> nil then
begin
Result := SM(0, Application.Handle, Message, MAPI_DIALOG or MAPI_LOGON_UI, 0);
end
else
Result := 1;
finally
FreeLibrary(MAPIModule);
end;
if Result <> 0 then
MessageDlg('Gagal mengirim email (' + IntToStr(Result) + ').', mtError, [mbOK], 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
SendMail(edtSubject.Text,
MemoMessage.Text,
'',
edtNamaPengirim.Text, edtEmailPengirim.Text,
edtNamaPenerima.Text, edtEmailPenerima.Text);
end;

end.