Remote Execute Function (Unix REXEC)

Problem/Question/Abstract:

Remote Execute Function (Unix REXEC)

Answer:

This function will execute a command to a Unix box (or any TCP connection that supports REXEC - port 512) and return the display results in a file. I currently use it on HP and SUN systems.

The parameters to RExec() are

  HostIP                                 : string               // eg. '196.11.121.160'          
  UserID                                 : string               // eg. 'root'
  Password                         : string                          // eg. 'fraqu34'
  Command                         : string                          // eg. 'export TERM=vt100; dv'
  ResultFilename         : string                           // eg. 'c:\temp\uxresult.txt'

The function returns true if sucessful, else false.

The command may contain multiple statements separated by semi-colons. REMEMBER : REXEC does not run the user .profile, so NO user environments are set. You can export  any environment settings in this parameter.

eg. 'export TERM=vt100; export APP=baan; run_mycommand'

An example of use is ....
(change to directory /var and return a dir listing and return results in file c:\temp\ux.txt)

procedure TForm1.Button1Click(Sender: TObject);
begin
  RExec('196.11.121.162',
    'root', 'passwd342',
    'cd /var; ls -1',
    'c:\temp\ux.txt');

  Memo1.Lines.LoadFromFile('c:\temp\ux.txt');
end;


uses ScktComp;

function RExec(const HostIP: string; const UserID: string;
  const Password: string; const Command: string;
  const ResultFilename: string): boolean;
var
  TCP: TClientSocket;
  i: integer;
  TxOut: file;
  Buffer, Cr, Lf: byte;
  Failed: boolean;
begin
  Failed := true; // Assume initial error state
  Cr := 13; // Carriage Return Char
  Lf := 10; // Line Feed Char
  TCP := TClientSocket.Create(nil);

  try
    TCP.Address := HostIP;
    TCP.ClientType := ctBlocking;
    TCP.Port := 512; // REXEC port
    TCP.Open;

    // Give time to connect
    for i := 1 to 500 do
      if not TCP.Active then
        Sleep(100)
      else
        break;

    // If TCP opened OK then send the command to host
    // and write results to specified file
    if TCP.Active then
    begin
      AssignFile(TxOut, ResultFileName);
      Rewrite(TxOut, 1);
      TCP.Socket.SendText('0' + #0);
      TCP.Socket.SendText(UserID + #0);
      TCP.Socket.SendText(Password + #0);
      TCP.Socket.SendText(Command + #0);
      TCP.Socket.SendText(#13);
      Sleep(20); // Give a gap to respond

      // Wait for resonse from Host
      // You may want to check for timeout here using
      // a TTimer. My complete function does this, but
      // have omitted for sake of clarity.
      while (TCP.Socket.ReceiveBuf(Buffer, 1) <> 1) do
        Application.ProcessMessages;

      // Write host byte stream to file
      while TCP.Socket.ReceiveBuf(Buffer, 1) = 1 do
      begin
        if (Buffer = 10) then
        begin
          BlockWrite(TxOut, Cr, 1);
          BlockWrite(TxOut, Lf, 1);
        end
        else
          BlockWrite(TxOut, Buffer, 1);
      end;

      TCP.Close;
      CloseFile(TxOut);
      Failed := false;
    end;
  finally
    TCP.Free;
  end;

  Result := not Failed;
end;

Play WAV files

Problem/Question/Abstract:

Play WAV files

Answer:

You can use the mci commands (easy using the mciSendString() routine) or - even easier, this:

uses
  MMSystem;

var
  s: array[0..79] of char;
begin
  StrCopy(s, 'ding.wav');
  sndPlaySound(s, 0);
end;

Get the server (router) and client IP address of your dial up connection

Problem/Question/Abstract:

There are quite a lot of articles on retrieving IP addresses for LAN interfaces. Here's one for dialup using RAS(Remote Access Services). Note that it requires header files which are available from Delphi JEDI site

Answer:

Please note that the program uses ras.pas and other header files which are available in the API library of delphi jedi site. The complete project having all the header files is being provided to the webmaster for update.

It displays the server and client IP every second on a label.

unit uMain;

interface

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

type
  TfrmMain = class(TForm)
    lblIP: TLabel;
    tmrUpdate: TTimer;
    procedure tmrUpdateTimer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses Ras, RasError;

{$R *.DFM}

procedure GetDialUpIpAddress(var server, client: string);
var
  RASPppIp: RASIP;
  lpcp: DWORD;
  ConnClientIP: array[0..RAS_MaxIpAddress] of Char;
  ConnServerIP: array[0..RAS_MaxIpAddress] of Char;

  Entries: PRasConn;
  BufSize, NumberOfEntries, Res: DWORD;
  RasConnHandle: THRasConn;
begin
  New(Entries);
  BufSize := Sizeof(Entries^);
  ZeroMemory(Entries, BufSize);
  Entries^.dwSize := Sizeof(Entries^);

  Res := RasEnumConnections(Entries, BufSize, NumberOfEntries);
  if Res = ERROR_BUFFER_TOO_SMALL then
  begin
    ReallocMem(Entries, BufSize);
    ZeroMemory(Entries, BufSize);
    Entries^.dwSize := Sizeof(Entries^);
    Res := RasEnumConnections(Entries, BufSize, NumberOfEntries);
  end;
  try
    if (Res = 0) and (NumberOfEntries > 0) then
      RasConnHandle := Entries.hrasconn
    else
      exit
  finally
    FreeMem(Entries);
  end;

  FillChar(RASPppIp, SizeOf(tagRASIP), 0);
  RASPppIp.dwSize := SizeOf(tagRASIP);
  lpcp := RASPppIp.dwSize;
  if RasGetProjectionInfo(RasConnHandle,
    RASP_PppIp, @RasPppIp, lpcp) = 0 then
  begin

    Move(RASPppIp.szServerIpAddress,
      ConnServerIP,
      SizeOf(ConnServerIP));
    Server := ConnServerIP;
    Move(RASPppIp.szIpAddress,
      ConnClientIP,
      SizeOf(ConnClientIP));
    client := ConnClientIP;
  end;
end;

procedure TfrmMain.tmrUpdateTimer(Sender: TObject);
var
  ConnServerIP, ConnClientIP: string;
begin
  GetDialUpIpAddress(ConnServerIP, ConnClientIP);
  if ConnServerIP = '' then
    ConnServerIP := 'NA';
  if ConnClientIP = '' then
    ConnClientIP := 'NA';
  lblIP.Caption := Format('Server : %s'#13#10'Client   : %s', [ConnServerIP,
    ConnClientIP])
end;

Viewing PCX File Format in Delphi (256-colors)

Problem/Question/Abstract:

How to show bitmap in pcx file format using Delphi ??

Answer:

This is quite simple way to answer above question: viewing pcx file format using Delphi. But this answer is limited only for 256-colors image (pcx image).

Here is the example code for the answer :

type
  TArrBuff = array[1..512] of Byte;
  TPalette_Cell = record
    r, g, b: byte;
  end;
  TPal = array[0..255] of TPalette_Cell;
  TPPal = ^TPal;

  TPCX_Header = record // PCX Header
    Manufacture, Version, Encoding, BpPixel: Byte;
    XMin, YMin, XMax, YMax, Hdpi, Vdpi: Smallint;
    ColorMap: array[0..15, 0..2] of Byte;
    Reserved, Nplanes: Byte;
    BpLpPlane, PaletteInfo, HScreenSize, VScreenSize: Smallint;
    Filer: array[74..127] of Byte;
  end;

var
  pal: TPPal;
  pFile: file;
  FPcxHeader: TPCX_Header;
  buffer: TArrBuff;

procedure THPPcx.ReadImageData2Bitmap;
var
  X, Y: Integer;
  i, Loop: Byte;
  data: Word;
  tmpClr: TColor;
begin
  X := FPcxHeader.XMin;
  Y := FPcxHeader.YMin;
  data := 1;
  BlockRead(pFile, Buffer, SizeOf(Buffer));
  while (Y <= FPcxHeader.YMax) do
  begin
    if (Buffer[data] and $C0) = $C0 then
    begin
      Loop := Buffer[data] and $3F;
      if data < SizeOf(Buffer) then
        Inc(data)
      else
      begin
        data := 1;
        BlockRead(pFile, Buffer, SizeOf(Buffer));
      end;
    end
    else
      Loop := 1;
    for i := 1 to Loop do
    begin
      tmpClr := rgb(pal^[Buffer[data]].R, pal^[Buffer[data]].G, pal^[Buffer[data]].B);
      SetPixel(Bitmap.Canvas.Handle, x, y, tmpClr);
      Inc(X);
      if X = FPcxHeader.BpLpPlane then
      begin
        X := FPcxHeader.XMin;
        Inc(Y);
      end;
    end;
    if data < SizeOf(Buffer) then
      Inc(data)
    else
    begin
      data := 1;
      BlockRead(pFile, Buffer, SizeOf(Buffer));
    end;
  end;
end;

procedure THPPCX.LoadFromFile(const FileName: string);
begin
  AssignFile(pFile, FileName);
{$I-}Reset(pFile, 1);
{$I+}
  if IOResult = 0 then
  begin
    BlockRead(pFile, FPcxHeader, SizeOf(FPcxHeader));
    if FPcxHeader.Manufacture = 10 then
    begin // valid pcx header id
      Bitmap.Width := FPcxHeader.XMax;
      Bitmap.Height := FPcxHeader.YMax;
      GetMem(pal, 768);
      try
        Seek(pFile, FileSize(pFile) - 768); // palette position
        BlockRead(pFile, pal^, 768);
        Seek(pFile, SizeOf(FPcxHeader)); // image data position
        ReadImageData2Bitmap;
      finally
        FreeMem(pal);
      end;
    end
    else
      MessageBox(Application.Handle, 'Not A Valid PCX File Format',
        'PCX Viewer Error', MB_ICONHAND);
    CloseFile(pFile);
  end
  else
    MessageBox(Application.Handle, 'Error Opening File', 'PCX Viewer Error',
      MB_ICONHAND);
end;

How to try this code ?? Just call the "LoadFromFile" procedure above in your application (probably with little modification offcourse, especially about the name of mainForm that I used here [THPPCX]).

Hopefully It can help you.

For full source code and simple application that use this, you can look and download from my website: www.geocities.com/h4ryp/delphi.html

How to use an animated cursor to your application

Problem/Question/Abstract:

How to use an animated cursor to your application

Answer:

Using animated cursors in your application is very easy.

Here's an example:

mycursor.ani is an animated cursor file. You can create those with Microsoft's aniedit.exe


const
  crMyCursor = 1;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Load the cursor. Needs to be done only once
  Screen.Cursors[crMyCursor] := LoadCursorFromFile('c:\mystuff\mycursor.ani');
  // Use the cursor with this form
  Cursor := crMyCursor;
end;

Change the font color of a specific row in a TListView

Problem/Question/Abstract:

How to change the font color of a specific row in a TListView

Answer:

Use the events OnCustomDrawItem and OnCustomDrawSubItem:

procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if (Item.Index mod 2) = 0 then
    Sender.Canvas.Font.Color := clRed
  else
    Sender.Canvas.Font.Color := clBlack;
end;

Share memory among several instances of a DLL

Problem/Question/Abstract:

Share memory among several instances of a DLL

Answer:

The DB unit in the 32-bit version has some examples of how it's done in general.

Basically, in 32-bit mode a DLL is mapped into each process's address space, not an address space of its own, so that it cannot share memory simply by virtue of being a DLL. You must use some kind of shared memory object -- such as shared memory, or a memory-mapped file -- and employ semaphores to properly synchronize access to it.

Have a window stay on top all the time

Problem/Question/Abstract:

Have a window stay on top all the time

Answer:

The following code results in a window that stays on top all the time, even when the main application form is in the background:


Minitool := TMinitool.Create(Self);
Application.NormalizeTopMosts;
SetWindowPos(Minitool.Handle, HWND_TOPMOST, 0, 0, 0, 0,
  SWP_NOACTIVATE + SWP_NOMOVE + SWP_NOSIZE);
Minitool.Show;

How to create an array of buttons at runtime

Problem/Question/Abstract:

How to create an array of buttons at runtime

Answer:

Here is a unit that creates a row of buttons and a label at run time and displays which button is clicked on. All you need to do is start a new project, then paste all the code below into Unit1.

unit Unit1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure ButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const
  b = 4; {Total number of buttons to create}

var
  ButtonArray: array[0..b - 1] of TButton; {Set up an array of buttons}
  MessageBox: TLabel;

procedure TForm1.FormCreate(Sender: TObject);
var
  loop: integer;
begin
  {Size the form to fit all the components in}
  ClientWidth := (b * 60) + 10;
  ClientHeight := 65;
  MessageBox := TLabel.Create(Self); {Create a label...}
  MessageBox.Parent := Self;
  MessageBox.Align := alTop; {...set up it's properties...}
  MessageBox.Alignment := taCenter;
  MessageBox.Caption := 'Press a Button';
  for loop := 0 to b - 1 do {Now create all the buttons}
  begin
    ButtonArray[loop] := TButton.Create(Self);
    with ButtonArray[loop] do
    begin
      Parent := self;
      Caption := IntToStr(loop);
      Width := 50;
      Height := 25;
      Top := 30;
      Left := (loop * 60) + 10;
      Tag := loop; {Used to tell which button is pressed}
      OnClick := ButtonClick;
    end;
  end;
end;

procedure TForm1.ButtonClick(Sender: TObject);
var
  t: Integer;
begin
  t := (Sender as TButton).Tag; {Get the button number}
  MessageBox.Caption := ' You pressed Button ' + IntToStr(t);
end;

end.

Implement tooltips in a TListView

Problem/Question/Abstract:

Is there a possibility to get tooltips in a common TListView component under Delphi 4.0? I want to display details if the user moves the mouse over an item and wait a little (same function like the component names in Delphi, if you move your mouse over a component).

Answer:

There is an event handler in Delphi 5, which makes it possible for you to get tooltips for each item of a ListView easily: TListView.OnInfoTip. In Delphi 3 and 4, you have to write your own hint event handler, which you assign to the method OnShowHint of TApplication:

unit Test_u1;
{ ... }

type
  TForm1 = class(TForm)
    ListView1: TListView;
    { ... }
  private
    procedure DisplayHint(var HintStr: string; var CanShow: Boolean; var HintInfo:
      THintInfo);
  end;

  { ... }

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  NewItem: TListItem;
begin
  Application.OnShowHint := DisplayHint;
  { ... }
end;

procedure TForm1.DisplayHint;
var
  Item: TListItem;
  Rect: TRect;
begin
  CanShow := true;
  {Trace the item of ListView1, which is found on the mouse position X, Y.
        If the mouse isn't dragged over a item, result will be nil.}
  Item := ListView1.GetItemAt(HintInfo.CursorPos.X, HintInfo.CursorPos.Y);
  if Item <> nil then
  begin
    Rect := Item.DisplayRect(drBounds); {in coordinates of ListView1!}
    HintInfo.HintStr := 'Mouse is over Item ' + Item.Caption;
  end
  else
  begin
    Rect := ActiveControl.ClientRect;
    HintInfo.HintStr := GetShortHint(TControl(ActiveControl).Hint);
  end;
  { Converting into coordinates of screen. }
  Rect.TopLeft := ActiveControl.ClientToScreen(Rect.TopLeft);
  Rect.BottomRight := ActiveControl.ClientToScreen(Rect.BottomRight);
  with HintInfo do
  begin
    HintPos.Y := Rect.Top + GetSystemMetrics(SM_CYCURSOR);
    HintPos.X := Rect.Left + GetSystemMetrics(SM_CXCURSOR);
    HintMaxWidth := TControl(ActiveControl).ClientWidth;
    HintColor := clInfoBk;
    ReshowTimeout := 10;
    HideTimeout := 100;
  end;
end;

end.

BTW: The type THintInfo is used to define the appearance and the function of the HintWindow:

type
  THintWindowClass = class of THintWindow;

  THintInfo = record
    HintControl: TControl;
    HintWindowClass: THintWindowClass;
    HintPos: TPoint;
    HintMaxWidth: Integer;
    HintColor: TColor;
    CursorRect: TRect;
    CursorPos: TPoint;
    ReshowTimeout: Integer;
    HideTimeout: Integer;
    HintStr: string;
    HintData: Pointer;
  end;

How to flip the characters in a string

Problem/Question/Abstract:

How to flip the characters in a string

Answer:

If you want to take "Hello" and make it "olleH" then use the following:

procedure Flip(A: string);
var
  t: Integer;
begin
  Result := '';
  for t := Length(A) downto 1 do
    Result := Result + A[t];
end;

If you want to take "abcd" and make it "zyxw" then use the following:

procedure Flip(A: string);
var
  t: Integer;
begin
  Result := '';
  A := Uppercase(A); {develop others for lower case}
  for t := 1 to Length(A) do
    Result := Result + CHR(91 - (ORD(A[t]) - 65));
end;

Filter operation on a lookup field

Problem/Question/Abstract:

How can I filter on a lookup field in a dataset?

Answer:

You cannot use the lookup field's name in the filter string, but you can use an OnFilterRecord event handler instead.

Recompile a component that is in a package

Problem/Question/Abstract:

Recently I had downloaded an updated freeware component and wanted to recompile the package in which I kept that one. The question was: in which package did I put this component?

Answer:

Choose menu item "Component | Configure Palette" or right click on the component palette and then choose Properties. A dialog with an overview comes up - sort it by component name and see the package name in the second column. Open this package and recompile it.

Adding Explorer ToolBar Btn

Problem/Question/Abstract:

Creating  Explorer ToolBar Button

Answer:

type
  TConnType = (COM_OBJECT, EXPLORER_BAR, SCRIPT, EXECUTABLE);

function AddBandToolbarBtn(Visible: Boolean; ConnType: TConnType;
  BtnText, HotIcon, Icon, GuidOrPath: string): string;
var
  GUID: TGUID;
  Reg: TRegistry;
  ID: string;
begin
  CreateGuid(GUID);
  ID := GuidToString(GUID);
  Reg := TRegistry.Create;
  with Reg do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey('\Software\Microsoft\Internet Explorer\Extensions\'
      + ID, True);
    if Visible then
      WriteString('Default Visible', 'Yes')
    else
      WriteString('Default Visible', 'No');
    WriteString('ButtonText', BtnText);
    WriteString('HotIcon', HotIcon);
    WriteString('Icon', Icon);
    case ConnType of
      COM_OBJECT:
        begin
          WriteString('CLSID', '{1FBA04EE-3024-11d2-8F1F-0000F87ABD16}');
          WriteString('ClsidExtension', GuidOrPath);
        end;
      EXPLORER_BAR:
        begin
          WriteString('CLSID', '{E0DD6CAB-2D10-11D2-8F1A-0000F87ABD16}');
          WriteString('BandCLSID', GuidOrPath);
        end;
      EXECUTABLE:
        begin
          WriteString('CLSID', '{1FBA04EE-3024-11D2-8F1F-0000F87ABD16}');
          WriteString('Exec', GuidOrPath);
        end;
      SCRIPT:
        begin
          writeString('CLSID', '{1FBA04EE-3024-11D2-8F1F-0000F87ABD16}');
          WriteString('Script', GuidOrPath);
        end;
    end;
    CloseKey;
    OpenKey('\Software\IE5Tools\ToolBar Buttons\', True);
    WriteString(BtnText, ID);
    CloseKey;
  finally
    Free;
  end;
  Result := ID;
end;