Is This Thread Safe?



Ladies / Gentlemen


Could someone or several someones please take a look at the
following code and tell me if this is thread safe and if not why not and how
to correct it.

Thanks

Mark Moss

{-----------------------------------------------------------------------------------------------------------------}

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPServer, ADODB, ComObj,
ActiveX;

type
TForm1 = class(TForm)

IdTCPServer1: TIdTCPServer;

procedure IdTCPServer1Execute(AThread: TIdPeerThread);

procedure Store_Init(AThread: TIdPeerThread);
procedure Store_Load(AThread: TIdPeerThread);
procedure Store_Query_Single(AThread: TIdPeerThread);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

{------------------------------------------------------------------------------}

ThreadVar

SQLCommand : String;
SQLOutput : String;

adoqST : TADOQuery;

Hold_ST_StoreID : String;
Hold_ST_StoreName : String;
Hold_ST_AddressLine1 : String;
Hold_ST_AddressLine2 : String;
Hold_ST_City : String;
Hold_ST_County : String;
Hold_ST_State : String;
Hold_ST_Country : String;
Hold_ST_PostalCode : String;
Hold_ST_ContactName : String;
Hold_ST_Phone1 : String;
Hold_ST_Phone2 : String;


{------------------------------------------------------------------------------}

implementation

{$R *.dfm}

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
begin

CoInitialize(nil);

try
with AThread.Connection do
begin

SQLCommand := ReadLn;

Store_Init(AThread);

Store_Query_Single(AThread);

Store_Load(AThread);

WriteLn(SQLOutput);

Store_Init(AThread);

Disconnect;

SQLCommand := '';
SQLOutput := '';

adoqST.Free;

end;

finally

CoUnInitialize();
end;

end;

{====================================================}

procedure TForm1.Store_Init(AThread: TIdPeerThread);
begin

Hold_ST_StoreID := '';
Hold_ST_StoreName := '';
Hold_ST_AddressLine1 := '';
Hold_ST_AddressLine2 := '';
Hold_ST_City := '';
Hold_ST_County := '';
Hold_ST_State := '';
Hold_ST_Country := '';
Hold_ST_PostalCode := '';
Hold_ST_ContactName := '';
Hold_ST_Phone1 := '';
Hold_ST_Phone2 := '';

end;

{====================================================}

procedure TForm1.Store_Load(AThread: TIdPeerThread);
begin

Hold_ST_StoreID :=
adoqST.FieldByName('StoreID').Text;
Hold_ST_StoreName :=
adoqST.FieldByName('StoreName').Text;
Hold_ST_AddressLine1 :=
adoqST.FieldByName('AddressLine1').Text;
Hold_ST_AddressLine2 :=
adoqST.FieldByName('AddressLine2').Text;
Hold_ST_City :=
adoqST.FieldByName('City').Text;
Hold_ST_County :=
adoqST.FieldByName('County').Text;
Hold_ST_State :=
adoqST.FieldByName('State').Text;
Hold_ST_Country :=
adoqST.FieldByName('Country').Text;
Hold_ST_PostalCode :=
adoqST.FieldByName('PostalCode').Text;
Hold_ST_ContactName :=
adoqST.FieldByName('ContactName').Text;
Hold_ST_Phone1 :=
adoqST.FieldByName('Phone1').Text;
Hold_ST_Phone2 :=
adoqST.FieldByName('Phone2').Text;


SQLOutput := Hold_ST_StoreID + ',' + Hold_ST_StoreName + ',' +
Hold_ST_AddressLine1 + ',' + Hold_ST_AddressLine2 + ',' + Hold_ST_City + ','
+ Hold_ST_State + ',' + Hold_ST_PostalCode + ',' + Hold_ST_ContactName + ','
+ Hold_ST_Phone1;

end;

{===================================================}

procedure TForm1.Store_Query_Single(AThread: TIdPeerThread);
begin

{------------------------------------------------------------------------------}

adoqST.Create(nil);

adoqST.ConnectionString := 'Provider=SQLOLEDB.1;Integrated
Security=SSPI;Persist Security Info=False; ' +
'User
ID=SBS2003\Administrator;Initial Catalog=SR4U;Data Source=SBS-2003; ' +
'Use Procedure for Prepare=1;Auto
Translate=True;Packet Size=4096; ' +
'Workstation ID=SBS-2003;Use
Encryption for Data=False; ' +
'Tag with column collation when
possible=False';

adoqST.CommandTimeout := 5000;

adoqST.SQL.Clear;

adoqST.SQL.Text := SQLCommand;

adoqST.Active := True;

{------------------------------------------------------------------------------}

end;

{---------------------------------------------------------------------------------------------------------}

end.

{---------------------------------------------------------------------------------------------------------}
{---------------------------------------------------------------------------------------------------------}
{---------------------------------------------------------------------------------------------------------}
{---------------------------------------------------------------------------------------------------------}



object Form1: TForm1
Left = 192
Top = 107
Width = 870
Height = 600
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object IdTCPServer1: TIdTCPServer
Bindings = <>
DefaultPort = 0
OnExecute = IdTCPServer1Execute
Left = 104
Top = 16
end
end


.