Pascal

2K

Solutions

1

Articles & Videos

2K

Contributors

Pascal is an influential imperative and procedural programming language, largely (but not exclusively) intended to teach students structured programming and data structuring. Pasca was implemented on a wide range of architectures, from early PCs to mainframes. Pascal derivatives include OOP-based Object Pascal (used in Delphi and Lazarus/Free Pascal). Pascal is a purely procedural language and includes control statements with reserved words, but has many data structuring facilities and other abstractions like type definitions, records, pointers, enumerations, and sets.

Share tech news, updates, or what's on your mind.

Sign up to Post

Hello Guys I'm new with Delphi which uses pascal language.
I'm trying to create simple application which loaded all values in sMemo.Text. All Strings were working fine except with Boolean values "CheckBox and radio Buttons"
here is the line I'm using
sMemo1.Lines.Add(sCheckBox1.Create );
it gives me an error
[DCC Error] Unit1.pas(44): E2035 Not enough actual parameters.

here is my whole code

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, sCheckBox, sRadioButton, sGroupBox, sButton, sEdit, sMemo,
  sLabel;

type
  TForm1 = class(TForm)
    sMemo1: TsMemo;
    sEdit1: TsEdit;
    sEdit2: TsEdit;
    sEdit3: TsEdit;
    sButton1: TsButton;
    sButton2: TsButton;
    sGroupBox1: TsGroupBox;
    sRadioButton1: TsRadioButton;
    sRadioButton2: TsRadioButton;
    sCheckBox1: TsCheckBox;
    sMemo2: TsMemo;
    sLabel1: TsLabel;
    procedure sButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.sButton1Click(Sender: TObject);
begin
sMemo1.Clear;
sMemo1.Lines.Add(sEdit1.Text);
sMemo1.Lines.Add(sEdit2.Text);
sMemo1.Lines.Add(sEdit3.Text);
sMemo1.Lines.Add(sCheckBox1.Create);
end;
end.


Anyone here knows that. My main purpose with this app is to load all configuration into memo instead of an ini file wich is easy to …
0
Enroll in June's Course of the Month
LVL 9
Enroll in June's Course of the Month

June's Course of the Month is now available! Every 10 seconds, a consumer gets hit with ransomware. Refresh your knowledge of ransomware best practices by enrolling in this month's complimentary course for Premium Members, Team Accounts, and Qualified Experts.

i am using this function to find node in treeview

function TFORM1.lookingTreeView(name: String): PVirtualNode;
var
Node: PVirtualNode;
Data: PUserData;
begin
Result := nil;
Node := VDT1.GetFirst;
while ((Node <> nil) and (Result = nil)) do
begin
Data := VDT1.GetNodeData(Node);
if (Data.FObject.name= name) then
begin
Result := Node;
break;
end
else
Node := VDT1.GetNext(Node);
end;
end;

Open in new window


and i use it like so
Node := lookingTreeView(namedata);

if Node <> nil then
begin
// then stop execute the code 
exit;
end;
// if its nil then do execute the rest of code

Open in new window


so this code search for node in Vst and if the node exits stop the code execution and if does not exits do the rest  

but some times this function got bypassed i mean when a node is already exits the if statement of node <> nil does not detect that its not nil and continue executing the code.
0
How do I use idhttp to login to instagram also add functionality to like and follow ?
0
Hello,

I have different shortcuts in my program but I want to let the users change the shortcuts, just like in Notepad++ Shortcut mapper.

I like help in following:

- How to implement this in Delphi easily (attaching shortcuts to buttons and actions)
- Directions what is the best method to save and load the users shortcuts in/from database (each user of the same program would have separate shortcut settings).

Thank you in advance.
0
i have this code to insert some node inside Tvirtuailstringtree it works but some time strange behavior happened

this Tvirtuailstringtree  are inside a Tpanel called pnlmc

here is the code


function AddMCVDTMIC(AVST: TCustomVirtualStringTree; ANode: PVirtualNode; AObject: TUMICX): PVirtualNode;
    var
      Data: PUserONMIC;
    begin
      Result := AVST.AddChild(ANode);
      Data := AVST.GetNodeData(Result);
      AVST.ValidateNode(Result, false);
      Data^.FObject := AObject;
    end;

procedure Tform1.Talkin;
var
Node: PVirtualNode;
Data: PUserData;
UMICX : TUMICX;
begin
Node := lookingTreeView(LineToid);
Data := VDT1.GetNodeData(Node);
if (Node <> nil) then
begin
VDT1.IsVisible[Node] := False;
vstmca.BeginUpdate;
try
vstmca.Clear;
UMICX := TUMICX.Create;
try Data.FObject.istalking := '12'; except end;
umicx.Username :=  Data.FObject.Username;
umicx.userUid := Data.FObject.userUid;
umicx.istalking := Data.FObject.istalking;
umicx.color := Data.FObject.color;
umicx.image := Data.FObject.image;

try AddMCVDTMIC(vstmca, nil, umicx);  except end;

finally
  vstmca.EndUpdate;
end;
end;

//

if (recorder.Active = True) and (LineToid = IntToStr(UniqueID)) then
begin
try button1.Visible := false; except end;
try stop1.Visible := True; except end;
end
else if (recorder.Active = false) then // enrecorder check
begin
try button1.Enabled := false; except end;
try button1.Caption := 'streamin'; except end;
end;


try pnlmc.Height := Data.FObject.iHeigh; 

Open in new window

0
i have combobox that have items  like
1
2
3
4

i want to add items based on number so if last item = 4 then add new item with

5
6
7
8

and so on

function Tpnlsettings.findTheme(tName : string): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to cmbThemes.Items.Count - 1 do
  begin
    if cmbThemes.Items.Strings[i] = tName then
    begin
      Result := i;
      Break;
    end;
  end;
end;

procedure Tpnlsettings.btnAddThemeClick(Sender: TObject);
var
  I: Integer;
begin
  i := findTheme(intTostr(cmbThemes.items.Count));
  if i <> -1 then
  begin
    cmbThemes.ItemIndex := i;
  end else
  begin
    cmbThemes.Items.Add(intTostr(cmbThemes.items.Count+1));
    cmbThemes.ItemIndex := cmbThemes.items.Count-1;
  end;

  objectEnabled(btnThemeChange,True);
end;

Open in new window


current code fail to add with same approach i needed
0
i have two tvirtualstringtree in a form i wanted to invalidate them using timers

but i stuck with problems it seems that only 1 VST got invalidated and the other one ignored any idear why ?

i use invalidate with current code within timer

procedure Tform1.Timerval1Timer(Sender: TObject);
{$J+}
Const
iCount: Cardinal = 0;
{$J-}
begin
Inc(iCount);
if (iCount * TTimer(Sender).Interval) > 500 then
begin
xbool := NOT xbool;
iCount := 0;
end;
VDT1.Invalidate;
end;

procedure Tform1.Timerval2Timer(Sender: TObject);
{$J+}
Const
iCount: Cardinal = 0;
{$J-}
begin
Inc(iCount);
if (iCount * TTimer(Sender).Interval) > 500 then
begin
xbool := NOT xbool;
iCount := 0;
end;
VDT2.Invalidate;
end;

Open in new window


issue happens when i use beforecellpaint on each VSt

procedure Tform1.VDT1BeforeCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
var
Data: PUserdataon;
NewRect: TRect;
xOff, yOff: Integer;

begin
GradientFillCanvas(TargetCanvas, clred, clWhite, CellRect, gdHorizontal); // GraphUtil

if not Assigned(Node) then
begin
exit;
end;

Data := vdt1.GetNodeData(Node);

begin
NewRect := CellRect;
NewRect.Left := NewRect.Left + 2;
NewRect.Width := 24;
NewRect.Top := NewRect.Top;
NewRect.Bottom := NewRect.Bottom;
xOff := CellRect.Left + 70;
yOff := CellRect.Top +((30 - TargetCanvas.TextHeight('H')) div 2);
if xbool or (Data.FObject.bool= false) then

Open in new window

0
i have this code to grab node from vst

function form1.lookingTreeView(name: String): PVirtualNode;
var
Node: PVirtualNode;
Data: PUserData;
begin
Result := nil;
Node := VDT1.GetFirst;
while ((Node <> nil) and (Result = nil)) do
begin
Data := VDT1.GetNodeData(Node);
if (Data.FObject.userUid = name) then
begin
Result := Node;
break;
end
else
Node := VDT1.GetNext(Node);
end;
end;

Open in new window


and i use it like so

var
Node: PVirtualNode;
Data: PUserData;
begin
Node := lookingTreeView('123456');
Data := VDT1.GetNodeData(Node);

Open in new window


i want to add this node to another vst list after i find it

lets say my other vst list called VDT2

i want to add the node thet i find from VDT1 To VDT2 and hide it from VDT1

what should i do ?
0
in my previous question i asked for the same question that i am asking now

https://www.experts-exchange.com/questions/28943546/how-do-i-use-on-compare-node-correctly-in-TVirtualStringTree.html

thats my old question. sadly answers did not solve the main issue i have

here is the current code

procedure Tform1.VDT1CompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
Data1, Data2: PUserData;
begin
Data1 := VDT1.GetNodeData(Node1);
Data2 := VDT1.GetNodeData(Node2);

      if (not Assigned(Data1)) or (not Assigned(Data2)) then
      begin //
        Result := 0;
        exit;
      end;


      //hand check  less than

      if (Data1.FObject.Userhand < Data2.FObject.Userhand) and (istalkon=True) then
      begin
        Result := -1;
        memo1.Lines.Add('is old date');
      end
      else
      if (Data1.FObject.Userhand < Data2.FObject.Userhand) and (istalkon=False) then
      begin
      Result := 1;
      end else

       // hand check greater than
      if (Data1.FObject.Userhand > Data2.FObject.Userhand) and (istalkon=True) then
      begin
        Result := -1;
        memo1.Lines.Add('is New date');
      end
      else
      if (Data1.FObject.Userhand > Data2.FObject.Userhand) and (istalkon=False) then
      begin
      Result := 1;
      end else

      //hand check  less than

      if (Data2.FObject.Userhand < Data1.FObject.Userhand) and (istalkon=True) then
      begin
        Result

Open in new window

0
i am using following code to send text data that saved inside memory stream
MS := TMemoryStream(OutboundCmds.Objects[I]);
        if MS <> nil then
        begin
          AContext.Connection.IOHandler.LargeStream := true;
          AContext.Connection.IOHandler.Write(MS, 0, true);
        end;
      end;

Open in new window


its sends text data correctly if its in english

but if its in other language like arabic it comes questions marks like this "?????" what could be the issue ?

here is how i add text to memory stream

procedure TConnection.sendData;
var
  I: integer;
  SL: TStringList;
  MS: TMemoryStream;
begin
  MS := TMemoryStream.Create;
  try
      SL := TStringList.Create;
      try
    begin
        SL.Add('مرحبا');
      end;

       if (SL.Count > 0) then
        begin
          SL.SaveToStream(MS);
          MS.Position := 0;
        end;
      finally
        SL.Free;
      end;
  finally
    MS.Free;
  end;

end;

Open in new window

0
Free Tool: ZipGrep
LVL 9
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

I am using Threads programming for the first time.
Can use the below mentioned Private variable 'sysAbort' as done below ?
Can I use sysNum Local Variable as done below ?
(I will be running only one instance of the thread at a time)


  private
    { Private declarations }
    sysAbort:Boolean ;

procedure TForm3.button_StartClick(Sender: TObject);
var
  sysNum:Integer ;
begin
  sysAbort:=False ;
  sysNum:=0 ;
  memo1.lines.add('Starting') ;
  with TThread.CreateAnonymousThread(
    procedure
    var
      MaxValue:Int64 ;
      I: Integer;
      Total: Integer;
    begin
      MaxValue:=1000 ;
      for I := 1 to MaxValue do
      begin
        if sysAbort then  // Can I use thus ?
          break ;
        sysNum:=I ;  // Can I use local variable
        // memo1.lines.Add('Violated  ' + Inttostr(sysNum)) ;  // This works too !
        if (I * 10 mod MaxValue) = 0 then
          TThread.Synchronize (TThread.CurrentThread,
            procedure ()
            begin
              memo1.lines.Add('Progress : ' + Inttostr(I)) ;
            end);

        sleep(10) ;   // just for delay
      end;

      TThread.Synchronize (TThread.CurrentThread,
        procedure ()
        begin
          memo1.lines.Add('End of process : ' + IntToStr(sysNum));
        end);
    end

  ) do
  begin
    OnTerminate := ThreadFinished ;
    Start;
  end;
end;

procedure TForm3.ThreadFinished(Sender: TObject);
begin
  if TThread(Sender).FatalException = nil then begin
    

Open in new window

1
i have this function that detect fast click

  function IsFlood:Boolean;
  var
  i, x : integer;
  begin
    Result := False;
    i := trunc(GetTickCount/2);
    x := trunc((i - LastFloodTime)/4);
    Result := False;
    if x < 180 then Result := True;
    LastFloodTime := i;
  end;

Open in new window


this function uses GetTickCount i want to use Tstopwatch instead any one can convert this function to Tstopwatch ?
1
i have this idhttp code that download images to memory stream and save it on disk

i want to convert jpeg images and png to GIF then save them to disk

if (itsimage = 'image/jpeg') or (itsimage = 'image/png') or (itsimage = 'image/gif') then
begin
try
aIdHttp.Get(trim(FURL), aMs);
except
end;
aMs.SaveToFile(path);
end;

try
if aIdHttp.Connected then
aIdHttp.Disconnect;

except // do not care about any errors yet, maybe log them later

end;

Open in new window

1
You can tell I'm a newbie. But everyhthing I've read tells me this should work.

unit AdvertisingAnalysisU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, pngimage, StdCtrls, jpeg, ExtCtrls, ComCtrls;

type
  TForm19 = class(TForm)
    Button1: TButton;
    Procedure GetAdvertisingSpend;


     private
    { Private declarations }

  public
    { Public declarations }

  end;

var
  Form19: TForm19;

implementation

{$R *.dfm}

Procedure GetAdvertisingSpend;
var a: integer;
begin
  a:=1;
end;
end.


So I get the message unsatisfied forward or external declaration on the GetAdvertisingSpend procedure.
1
i have a server that client connect To .   each client on server have its own mydac TMyConnection. but every time new client connect to server old clients have the new client data base which is wrong step here is my server code

type
  TConnection = class(TIdServerContext)
  private
    // WriteLock: TCriticalSection;
    dbconnect: TMyConnection;

  public
    OutboundCache: TIdThreadSafeStringList;
    Name: String;
    Databasename : string;

    constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn;
      AList: TIdContextThreadList = nil); override;
    destructor Destroy; override;


constructor TConnection.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn;
  AList: TIdContextThreadList = nil);
begin
  inherited;
  // WriteLock := TCriticalSection.Create;
  OutboundCache := TIdThreadSafeStringList.Create;
  dbconnect := TMyConnection.Create(nil);
  dbconnect.Pooling := true;
  dbconnect.PoolingOptions.Validate := true;
  dbconnect.Server := 'localhost';
  dbconnect.username := 'root';
  dbconnect.Password := 'password';
  dbconnect.ConnectionTimeout := 0;
  connectionmo.userslq.Connection := dbconnect;
end;

destructor TConnection.Destroy;
var
  Cache: TStringList;
  I: integer;
begin
  // WriteLock.Free;
  if OutboundCache <> nil then
  begin
    Cache := OutboundCache.Lock;
    try
      for I := 0 to Cache.Count - 1 do
        Cache.Objects[I].Free;
    finally
      OutboundCache.Unlock;
    end;
    OutboundCache.Free;
  end;
  inherited;
end;

Open in new window


Server execute



Open in new window

0
i have this code that send data to each client connected where client value equals to something

procedure TConnection.BroadCastTextMessage(const TextMessage: String;
const FromUniqueID: Dword; const FromName: string);
var
  List: TList;
  I, J: integer;
  Connection: TConnection;
  Channel: string;
begin
  List := Server.Contexts.LockList;
  try
    for I := 0 to List.Count - 1 do
    begin
      Connection := TConnection(List.Items[I]);
      if Connection.UniqueID = FromUniqueID then
      begin
        Channel := Connection.Channel;
        for J := 0 to List.Count - 1 do
        begin
          Connection := TConnection(List.Items[J]);
          if (Connection <> Self) and (Connection.Channel= Channel) then
          begin
            try
              Connection.SendCommandWithParams('TEXTMESSAGE',
                FromName + Sep + TextMessage + Sep);
            except
            end;
          end;
        end;
        Exit;
      end;
    end;
  finally
    Server.Contexts.UnlockList;
  end;
end;

Open in new window


this code brodcats  a text to each client connected where this client channle variable equals to sender is this the best way to do  ? also i want to add more stuff like if (Connection <> Self) and (Connection.Channel= Channel)  and connection.otherdata = same data to each client connected should i use self.otherdata then ?
0
is this bad setting in delphi ide ? or some mistake of mine ? my exe application get too long to be able to right click on it and my processor gets to hiegh if  try to move it from folder to another or even right click to copy

this issue happend with each exe project i made with Delphi even empty projects . the Antimalware execute on windows 8 takes to long and high process to verify the exe that maded with delphi

other exe on disk never hang on what could be the issue ?
0
any way to create html5 client that can connect to tidtcpserver and exchange data between it  ?

i found this component http://websockets.esegece.com/

 but dont know how to mirage it to my server application

any sample code can be provided ?
0
i currently have this parse function to parse strings inside string list


procedure admlistparse(starting: string; var Username, Access: string);
var
  P, I: Integer;
begin
  I := 0;
  repeat
    P := Pos(Sep, starting);
    if P <> 0 then
    begin
      Inc(I);
      case I of
        1: Username := Copy(starting, 1, P - 1);
        2: Access := Copy(starting, 1, P - 1);
      end;
      Delete(starting, 1, P + Length(Sep) - 1);
    end;
  until (I = 2) or (P = 0) or (starting = '') end;

procedure Tform1.gettextfromms;
    var
      I: Integer;
      starting: string;
      Username, Access: String;
      SL: TStringList;
    begin
      if Assigned(Ms) then
      begin
        SL := TStringList.Create;
        try
          SL.LoadFromStream(Ms);
          for I := 0 to SL.Count - 1 do
          begin
            starting := SL.Strings[I];
            admlistparse(starting, Username,  Access);
              memo1.Lines.Add('Username : ' + SL.Strings[I]);
          end;
        finally
          SL.Free;
        end;
      end;

    end;

Open in new window


now get text from MS procedure should get text like this

Drama#$%^&1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s1:s#$%^&

Open in new window


So i use #$%^& as separator to get this string as tow lines or maybe more if there is other string inside it

but i had on e issue that name Drama comes with second empty string any idea why ?
1
On Demand Webinar: Networking for the Cloud Era
LVL 9
On Demand Webinar: Networking for the Cloud Era

Ready to improve network connectivity? Watch this webinar to learn how SD-WANs and a one-click instant connect tool can boost provisions, deployment, and management of your cloud connection.

i have this code to read some strings from php file

function GetNet(strURL: string): string;
const
  bufSiz = 512;
var
  aHI, aHURL: HINTERNET;
  buf: string;
  bytesRead: cardinal;
  aBool: boolean;
  url : string;
begin
  url := strURL;
  Result := '';
  strURL := '';
  try
    ahI := InternetOpen('cLIENT', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil,
      INTERNET_FLAG_MAKE_PERSISTENT);
    if (aHI = nil) then exit;
    aHURL := InternetOpenURL(aHI, PChar(url), nil, 0,
      INTERNET_FLAG_EXISTING_CONNECT or
      INTERNET_FLAG_MAKE_PERSISTENT, 0);
    if (aHURL = nil) then exit;
    strURL := '';
    repeat
      buf := '';
      SetLength(buf, bufSiz);
      aBool := InternetReadFile(aHURL, PChar(buf), bufSiz, bytesRead);
      SetLength(buf, bytesRead);
      if (aBool and (bytesRead <> 0)) then
        strURL := strURL + buf;
    until (aBool and (bytesRead = 0)) or (not aBool);
    Result := strURL;
    Showmessage(strURL);
    InternetCloseHandle(aHURL);
    InternetCloseHandle(aHI);
  finally
    buf := '';
  end;
end;

Open in new window


sadly data comes out Chinese charters and what i have there is not Chinese charter any idea why ?

it shows result like this

[Window Title]
Project1

[Content]
⸰楧੦〰朮晩《〰朮晩《〰⸰楧੦〰〰⸰楧੦〰〰〰朮晩《〰⸱楧੦〰⸱楧੦〰〱朮晩《㈰⸳楧੦〰㐲朮晩《㈰⸵楧੦〰㘲朮晩《㜰朮晩《ㄱ朮晩《㈱朮晩《㌱朮晩《㐱朮晩《㌲朮晩《㐲朮晩《㔲朮晩《㔲⹃楧੦㈰䐵⹣楧੦㈰⸶楧੦㈰䌶⹖楧੦㈰夶婚⹚楧੦㈰娶⹚楧੦㈰愶朮晩《㘲祹朮晩《⸳楧੦㐰朮晩《⸵楧੦㘰朮晩《⸷楧੦㤰朮晩ㄊ㔰㔵砵㌳㌳㘶㘶㘶㘶硸⹸楧੦〱㔵㔵㝸摤㑤㐵⸵楧੦㈱㐳㌵空空硸硸硸硸朮晩ㄊ㐲㘵稳空空空空硺⹸楧੦㌱朮晩㈊⸰楧੦ㄲ朮晩㈊⸲楧੦㌲朮晩㈊㌳䜲䙈呄朮晩㈊⸴楧੦㔲朮晩㌊朮晩㌊㌳㌳稳空空㘷⹢楧੦㐳㈳稱空空空空⹺楧੦⸴楧੦⸵楧੦㔵

[OK]

Open in new window

0
i want to search for nodes using Tedit , so when i type in tedit i show only matched node in the VTS i try like so

procedure Tform1.SearchForText(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
var
  NodeData: PuserData; //replace by your record structure
begin
  NodeData := Sender.GetNodeData(Node);
  Abort := AnsiStartsStr(string(data), NodeData.FObject.username); //abort the search if a node with the text is found.
then i dont know what to do 
end;

procedure Tform1.txtFilterChange(Sender: TObject);
var
  foundNode : PVirtualNode;
begin

foundNode := VDT.IterateSubtree(nil, SearchForText, pointer(txtFilter.text));

  if Assigned (foundNode) then
  begin
//dont know what to do here
  end;

end;

Open in new window


I couldn't search for node or even this code do any thing
1
when i try to execute color with this code  inside my dll application after execution the form disappear any idea why ?

var
  oldHandle : THandle;
  clr : TColorDialog;
begin
  clr := TColorDialog.Create(Self);
  try
    oldHandle := Application.Handle;
    Application.Handle := Self.Handle;
    try
      if clr.Execute then
        pnlColor.Color := clr.Color;
    finally
      Application.Handle := oldHandle;
    end;
  finally
    FreeAndNil(clr);
  end;
end;

Open in new window

0
i have this function in activex application to grab ie url
function Get_URL(Servicio: string): String;
var
  Cliente_DDE: TDDEClientConv;
  S: AnsiString;
begin
  Result := '';
  Cliente_DDE := TDDEClientConv.Create(nil);
  with Cliente_DDE do
  begin
    SetLink(Servicio, 'WWW_GetWindowInfo');
    S := RequestData('0xFFFFFFFF');
    Result := string(System.AnsiStrings.StrPas(PAnsiChar(S)));
    CloseLink;
  end;
  Cliente_DDE.Free;
end;


procedure Tform1.siteurl;
var
URI: TIdURI;
LinK : String;
Temp: string;
Host,sExt: String;
Path : string;
begin
Link := Get_URL('IExplore');
Temp := Copy(Link, 1, Pos(',', Link) - 1);
Temp := StringReplace(Temp, '"', '', [rfReplaceAll]);

URI := TIdURI.Create(Temp);
try
Host := URI.Host;
Path := URI.Path;
Host := StringReplace(Host ,'www.', '',[rfReplaceAll,rfIgnoreCase]);
sExt  := ExtractFileExt(Host);
Host := Copy(Host, 1, Length(Host) - Length(sExt));
finally
  URI.Free;
end;

memo1.Lines.Add(HOST)
end;

Open in new window


this code works in exe but not working in activex , any idea why ?
0
i have this url www.google.com i want only get google from it no www. or .com

i do

Host := 'www.google.com';
Host := StringReplace(Host ,'www.', '',[rfReplaceAll,rfIgnoreCase]);
Host := StringReplace(Host ,'.com', '',[rfReplaceAll,rfIgnoreCase]);

Open in new window


could i do it better ? because what if google is .de or other
1
Simple SQL Query usuing ADO in Delphi connected to Access Database:

procedure TForm1.Button1Click(Sender: TObject);
begin
With AdoQuery1 do begin
  Open;
  SQL.Clear;
  SQL.Add('SELECT * FROM Table1');
  SQL.Add('WHERE Number='+SpinEdit1.value);
  ExecSql;
end;
end;

Keeps throwing up the error: E2010 Incompatible types: 'string' and 'Integer'

Used to work fine in earlier version of Windows but every time an integer or double is used I get the same error. Thought it might have something to do with Access, but I ran the query just on Access and it worked fine. Have tried with both OLEDB 4.0 and 12.0 connections,
0

Pascal

2K

Solutions

1

Articles & Videos

2K

Contributors

Pascal is an influential imperative and procedural programming language, largely (but not exclusively) intended to teach students structured programming and data structuring. Pasca was implemented on a wide range of architectures, from early PCs to mainframes. Pascal derivatives include OOP-based Object Pascal (used in Delphi and Lazarus/Free Pascal). Pascal is a purely procedural language and includes control statements with reserved words, but has many data structuring facilities and other abstractions like type definitions, records, pointers, enumerations, and sets.

Top Experts In
Pascal
<
Monthly
>

No Top Experts for this time period. Answer questions to earn the title!