From TCheckListBox to TcxCheckListBox with an exception? - delphi

I use this code with TCheckListbox (lbServices) and it works fine. But with TcxCheckListBox from Devexpress it raise exception.
procedure TMaintenanceForm.AfterConstruction;
var
i: Integer;
ActionObj: TAction;
begin
inherited;
for i := 0 to ServiceActionList.ActionCount-1 do
begin
ActionObj := ServiceActionList.Actions[i] as TAction;
lbServices.Items.AddObject(ActionObj.Caption, ActionObj);
end;
end;
procedure TMaintenanceForm.btnStopClick(Sender: TObject);
begin
fContinue := False;
end;
procedure TMaintenanceForm.cmdExecuteSelectedClick(Sender: TObject);
var
i: Integer;
begin
Screen.Cursor := crHourGlass;
try
for i := 0 to lbServices.Count -1 do
if lbServices.Selected[i] then
(lbServices.Items.Objects[i] as TAction).Execute; // Exception here!!!!
finally
Screen.Cursor := crDefault;
end;
end;
If I debug the code lbServices.Count = 12.
lbServices.Items.Objects[i] is nil for all items in the list. What is wrong here ?


Use the following code instead:
var
AItem: TcxCheckListBoxItem;
begin
AItem := cxCheckListBox1.Items.Add;
AItem.ItemObject := Action1;
AItem.Text := Action1.Caption;
end;
...
var
I: Integer;
begin
for I := 0 to cxCheckListBox1.Items.Count - 1 do
if cxCheckListBox1.Items[I].Checked then
(cxCheckListBox1.Items[I].ItemObject as TACtion).Execute;
end;


There is no Objects property of TcxCheckListBox.Items

Related

IdPOP3, IdMessage and attachment gmail

I need help, please. I can connect to Gmail and I can receive emails.
What I can't do is to save attachments. I think that it is a setting problem? I have IdAttachment and IdAttachmentFile in my uses clause. I tried all sorts of ContentType settings, but nothing seams to work.
if (IdMessage1.MessageParts.Items[i] is TIdAttachment) then
begin
with (IdMessage1.MessageParts.Items[i] as TIdAttachment) do
begin
SaveToFile('C:\test123.txt');
end;
end;
Here is my code:
procedure TForm1.Button1Click(Sender: TObject);
var
i, j: Integer;
IdSSLIOHandlerSocket: TIdSSLIOHandlerSocketOpenSSL;
bodytext: string;
s: string;
n: string;
mailcount : integer;
TMP: string;
begin
IdSSLIOHandlerSocket := TIdSSLIOHandlerSocketOpenSSL.Create(Self);
idpop31.IOHandler := IdSSLIOHandlerSocket;
idpop31.UseTLS := utUseImplicitTLS;
IdPOP31.Host := 'pop.gmail.com';
IdPOP31.Port := 995;
IdPOP31.UseTLS := utUseImplicitTLS;
IdPOP31.Username := 'name#gmail.com';
IdPOP31.Password := 'xxxxx';
IdPOP31.Connect;
Mailcount:= idpop31.checkmessages;
For i:= 1 to mailcount do
Begin
Idmessage1.clear;
Idpop31.retrieveheader (i,idmessage1);
TMP:= idmessage1.subject;
Mailzeug.lines. Add (TMP);
Idpop31.retrieve (i,idmessage1);
TMP:= idmessage1.body.Text;
Mailzeug.lines. Add (TMP);
if (IdMessage1.MessageParts.Items[i] is TIdAttachment) then
begin
TIdAttachment(IdMessage1.MessageParts.Items[i]).SaveToFile(TIdAttachment(IdMessage1.MessageParts.Items[I]).Filename);
end;
end;
Idpop31.disconnect;
end;

You are using the wrong index value with the IdMessage1.MessageParts.Items[] property, that is why you are getting an "out of range" error. You are using the email's (1-based) index within the mailbox as-if it were a (0-based) attachment index within the email.
You need a 2nd loop to iterate the MessageParts collection of each email that is downloaded, eg:
procedure TForm1.Button1Click(Sender: TObject);
var
i, j: Integer;
IdSSLIOHandlerSocket: TIdSSLIOHandlerSocketOpenSSL;
BodyText: string;
MailCount : integer;
part: TIdMessagePart;
begin
IdSSLIOHandlerSocket := TIdSSLIOHandlerSocketOpenSSL.Create(Self);
IdPOP31.IOHandler := IdSSLIOHandlerSocket;
IdPOP31.Host := 'pop.gmail.com';
IdPOP31.Port := 995;
IdPOP31.UseTLS := utUseImplicitTLS;
IdPOP31.Username := 'name#gmail.com';
IdPOP31.Password := 'xxxxx';
IdPOP31.Connect;
try
MailCount := IdPOP31.CheckMessages;
for i := 1 to MailCount do
begin
IdMessage1.Clear;
IdPOP31.Retrieve(i, IdMessage1);
Mailzeug.Lines.Add(IdMessage1.Subject);
BodyText := IdMessage1.Body.Text;
Mailzeug.Lines.Add(BodyText);
for j := 0 to IdMessage1.MessagePart.Count-1 do
begin
part := IdMessage1.MessageParts.Items[j];
if (part is TIdAttachment) then
begin
TIdAttachment(part).SaveToFile(TIdAttachment(part).Filename);
end;
end;
end;
finally
IdPOP31.Disconnect;
end;
end;

Delphi 7 - Check if server is online

I have a program created in Delphi 7 that uses ftp downloading.
How can i insert into that program to check for a server status?
For example if server is online to produce a green image, if server is offline o produce a red image. Here is the code.
unit Download;
interface
uses
Classes, Wininet, Windows, SysUtils, Dialogs, Forms;
type
GFilesThread = class(TThread)
private
LTemp : Longword;
STemp : string;
FilesToGet : TStringList;
FilesSize : Longword;
CBackup : integer;
CRevision : integer;
CForceCheck : boolean;
CSwitch : integer;
UUrl : string;
USelfParam : string;
Dir: string;
FSource: TStream;
protected
procedure Execute; override;
procedure UpdateFileProgress;
procedure SetFileProgressMax;
procedure UpdateStatusLabel;
procedure UpdateFileDecompStat;
procedure UpdateFilesProgress;
procedure CheckFiles(FList : TStringList);
procedure BZProgress(Sender: TObject);
procedure LockFMain;
procedure UNLockFMain;
procedure GetFiles;
procedure SelfUpdate(SelfVal : string);
procedure UpdateRevision;
procedure ModHosts(Lines : TStringList);
procedure DoUncompressStream(ASource, ADest: TStream);
procedure DoUncompress(const ASource, ADest: TFileName);
function HTTPGetFile(const fileURL, FileName: string; sh_progress: boolean): boolean;
public
property CreateBackup : integer write CBackup;
property UpdatesUrl : string write UUrl;
property LocalRevision : integer write CRevision;
property ForceCheck : boolean write CForceCheck;
end;
implementation
uses Launcher, CheckFiles, BZip2, md5, FileList;
// -------- by 667
procedure GFilesThread.UpdateStatusLabel;
begin
FMain.Label3.Caption:=STemp;
end;
procedure GFilesThread.SetFileProgressMax;
begin
if(CSwitch=0) then
FMain.Gauge1.MaxValue:=LTemp;
if(CSwitch=1) then
FMain.Gauge2.MaxValue:=LTemp;
end;
procedure GFilesThread.UpdateFileProgress;
begin
FMain.Gauge1.Progress:=LTemp;
end;
procedure GFilesThread.UpdateFilesProgress;
begin
FMain.Gauge2.Progress:=LTemp;
end;
procedure GFilesThread.UpdateRevision;
begin
FMain.UpdateRevision(IntToStr(CRevision));
end;
procedure GFilesThread.UpdateFileDecompStat;
begin
FMain.Gauge1.Progress:=LTemp;
end;
procedure GFilesThread.BZProgress(Sender: TObject);
begin
LTemp:=FSource.Position;
Synchronize(UpdateFileDecompStat);
end;
procedure GFilesThread.LockFMain;
begin
Fmain.ImgBtn1.Visible:=False;
Fmain.ImgBtn2.Visible:=False;
Fmain.ImgBtn5.Enabled:=False;
end;
procedure GFilesThread.UNLockFMain;
begin
Fmain.ImgBtn1.Visible:=True;
Fmain.ImgBtn2.Visible:=True;
Fmain.ImgBtn5.Enabled:=True;
end;
// --------- by 667
function GFilesThread.HTTPGetFile(const fileURL, FileName: string; sh_progress: boolean): boolean;
const
BufferSize = 1024;
var
hSession, hURL: HInternet;
Buffer: array[1..BufferSize] of Byte;
BufferLen: Longword;
f: file;
sAppName: string;
begin
Result := False;
sAppName := 'L2ClientUpdater';
LTemp:=0;
hSession := InternetOpen(PChar(sAppName),
INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
try
hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, 0, 0);
if (hURL <> nil) then begin
try
DeleteUrlCacheEntry(PChar(fileURL));
AssignFile(f, FileName);
Rewrite(f,1);
repeat
InternetReadFile(hURL, #Buffer, SizeOf(Buffer), BufferLen);
BlockWrite(f, Buffer, BufferLen);
if (sh_progress) then
begin
LTemp:=LTemp+BufferLen;
Synchronize(UpdateFileProgress);
end;
until
BufferLen = 0;
CloseFile(f);
Result := True;
finally
InternetCloseHandle(hURL);
end;
end;
finally
InternetCloseHandle(hSession);
end;
LTemp:=0;
Synchronize(UpdateFileProgress);
end;
procedure GFilesThread.DoUncompress(const ASource, ADest: TFileName);
var
Source, Dest: TStream;
begin
Source := TFileStream.Create(ASource, fmOpenRead + fmShareDenyWrite);
try
Dest := TFileStream.Create(ADest, fmCreate);
try
DoUncompressStream(Source, Dest);
finally
Dest.Free;
end;
finally
Source.Free;
DeleteFile(ASource);
end;
end;
procedure GFilesThread.DoUncompressStream(ASource, ADest: TStream);
const
BufferSize = 65536;
var
Count: Integer;
Decomp: TBZDecompressionStream;
Buffer: array[0..BufferSize - 1] of Byte;
begin
FSource := ASource;
LTemp:=FSource.Size;
CSwitch:=0;
Synchronize(SetFileProgressMax);
Decomp := TBZDecompressionStream.Create(ASource);
try
Decomp.OnProgress := BZProgress;
while True do
begin
Count := Decomp.Read(Buffer, BufferSize);
if Count <> 0 then ADest.WriteBuffer(Buffer, Count) else Break;
end;
finally
Decomp.Free;
FSource := nil;
LTemp:=0;
Synchronize(UpdateFileDecompStat);
end;
end;
procedure GFilesThread.CheckFiles(FList : TStringList);
var
i: integer;
FParam: TStringList;
FNameLocal: string;
begin
if(FList.Count>0) and (FList[0]<>'FAIL') and (not terminated) then
begin
STemp:='Checking files';
Synchronize(UpdateStatusLabel);
CSwitch:=1;
LTemp:=FList.Count-1;
Synchronize(SetFileProgressMax);
FParam:=TStringList.Create;
for i:=0 to FList.Count-1 do
begin
LTemp:=i;
Synchronize(UpdateFilesProgress);
FParam:=Tokenize(FList[i],'|');
FNameLocal:=Dir+FParam[2];
STemp:='Checking '+FParam[2];
Synchronize(UpdateStatusLabel);
if (not FileExists(FNameLocal)) then
begin
FilesToGet.Add(FList[i]);
FilesSize:=FilesSize+StrToInt(FParam[0]);
end
else
begin
if (MD5Print(MD5File(FNameLocal))<>FParam[1]) then
begin
FilesToGet.Add(FList[i]);
FilesSize:=FilesSize+StrToInt(FParam[0]);
end;
end;
end;
FParam.Free;
LTemp:=0;
Synchronize(UpdateFilesProgress);
STemp:='';
Synchronize(UpdateStatusLabel);
end;
end;
procedure GFilesThread.SelfUpdate(SelfVal : string);
var
FParam: TStringList;
FNameLocal: string;
F:boolean;
begin
if(SelfVal<>'') then
begin
FParam:=TStringList.Create;
FParam:=Tokenize(SelfVal,'|');
FNameLocal:=Dir+FParam[2];
if (MD5Print(MD5File(FNameLocal))<>FParam[1]) then
begin
FilesSize:=FilesSize+StrToInt(FParam[0]);
F:=HTTPGetFile(UUrl+FParam[2]+'.bz2',FNameLocal+'.bz2',True);
if(F) then begin
try
DoUncompress(FNameLocal+'.bz2',Dir+FParam[2]+'.New');
GenKillerBat(FParam[2]);
RunApp(Dir+'Update.bat');
except
STemp:='Update Failed';
DeleteFile(FNameLocal);
end;
end;
end;
FParam.Free;
end;
end;
procedure GFilesThread.ModHosts(Lines : TStringList);
var
Hosts : textfile;
H, HostsStrings, HostLineParam : TStringList;
HostsPath, temp : string;
i, z, funnyFlag : integer;
WindirP : PChar;
Res : cardinal;
begin
WinDirP := StrAlloc(MAX_PATH);
Res := GetWindowsDirectory(WinDirP, MAX_PATH);
if Res > 0 then
begin
if(FileExists(StrPas(WinDirP)+'\system32\drivers\etc\hosts.msn')) then
HostsPath := StrPas(WinDirP)+'\system32\drivers\etc\hosts.msn'
else
HostsPath := StrPas(WinDirP)+'\system32\drivers\etc\hosts';
AssignFile(Hosts,HostsPath);
Reset(Hosts);
HostsStrings:= TStringList.Create;
H:= TStringList.Create;
H.Add('#-------- Added by L2Updater --------');
while (not Eof(Hosts)) do
begin
ReadLn(Hosts, temp);
HostsStrings.Add(Trim(temp));
end ;
Reset(Hosts);
for i:=0 to Lines.Count-1 do
begin
funnyFlag:=0;
HostLineParam:=Tokenize(Lines[i],'|');
for z:=0 to HostsStrings.Count-1 do
begin
if (StrSearch(1,HostsStrings[z],HostLineParam[0])>0) and (HostsStrings[z][1]<>'#') then
begin
if (StrSearch(1,HostsStrings[z],HostLineParam[1]+#9)= 0) and (StrSearch(1,HostsStrings[z],HostLineParam[1]+' ')= 0 ) then
begin
HostsStrings[z]:= '#'+HostsStrings[z];
funnyFlag:=1;
end
else funnyFlag:=2;
end;
end;
if (funnyFlag=1) or (funnyFlag=0) then
H.Add(HostLineParam[1]+#9+HostLineParam[0]);
end;
H.Add('#-----------------');
if H.Count>2 then
begin
Rewrite(Hosts);
STemp:='Applying changes to Hosts';
Synchronize(UpdateStatusLabel);
for i:=0 to HostsStrings.Count-1 do
begin
WriteLn(Hosts,HostsStrings[i]);
end;
for i:=0 to H.Count-1 do
begin
WriteLn(Hosts,H[i]);
end;
STemp:='Hosts file chamged';
Synchronize(UpdateStatusLabel);
end;
H.Free; HostsStrings.Free; HostLineParam.Free;
CloseFile(Hosts);
end;
end;
procedure GFilesThread.GetFiles;
var
FParam : TStringList;
i : integer;
F, error : boolean;
LocalFile, BakFile: string;
begin
error := False;
if (FilesToGet.Count>0) then
begin
FParam:=TStringList.Create;
LTemp:=FilesToGet.Count-1;
CSwitch:=1;
Synchronize(SetFileProgressMax);
i:=0;
while (i < FilesToGet.Count) and (not terminated) do
begin
FParam:=Tokenize(FilesToGet[i],'|');
LocalFile:= Dir+FParam[2];
STemp:='Downloading '+ FParam[2];
Synchronize(UpdateStatusLabel);
CSwitch:=0;
LTemp:= StrToInt(FParam[0]);
Synchronize(SetFileProgressMax);
if (not DirectoryExists(ExtractFilePath(LocalFile))) then
ForceDirectories(ExtractFilePath(LocalFile));
F:=HTTPGetFile(UUrl+ReplaceStr(FParam[2],'\','/')+'.bz2',LocalFile+'.bz2',True);
if (F) then
begin
try
if (CBackup=1) then
begin
BakFile:=Dir+'backup\'+FParam[2];
if (not DirectoryExists(ExtractFilePath(BakFile))) then
ForceDirectories(ExtractFilePath(BakFile));
CopyFile(PChar(LocalFile),PChar(BakFile),false);
end;
STemp:='Extracting '+ FParam[2];
Synchronize(UpdateStatusLabel);
DoUncompress(LocalFile+'.bz2',Dir+FParam[2]);
except
STemp:='Update Failed';
error := True;
end;
end
else
begin
STemp:='Update Failed';
error := True;
Break;
end;
inc(i);
LTemp:=i;
CSwitch:=1;
Synchronize(UpdateFilesProgress);
end;
LTemp:=0;
Synchronize(UpdateFilesProgress);
FParam.Free;
if (not error) then
STemp:='All files have been updated.';
end
else STemp:='';
end;
procedure GFilesThread.Execute;
var
List: TListFile;
CFiles, NFiles, HostsLines : TStringList;
TRev, IsModHosts : integer;
F : boolean;
begin
Dir:=GetCurrentDir+'\';
FilesSize:=0;
Synchronize(LockFMain);
STemp:='Downloading updates list';
Synchronize(UpdateStatusLabel);
if(UUrl[length(UUrl)]<>'/') then UUrl:=UUrl+'/';
F:=HTTPGetFile(UUrl+'files.lst.bz2',Dir+'files.lst.bz2', True);
if (F) then
begin
STemp:='';
Synchronize(UpdateStatusLabel);
try
DoUncompress(Dir+'files.lst.bz2',Dir+'files.lst');
except
STemp:='Update Failed';
Synchronize(UpdateStatusLabel);
DeleteFile(Dir+'files.lst');
end;
if(FileExists(Dir+'files.lst')) then
begin
FilesToGet := TStringList.Create;
List := TListFile.Create(Dir+'files.lst');
CFiles:=TStringList.Create;
TRev:=StrToInt(List.GetKeyValue('settings','Rev'));
IsModHosts:=StrToInt(List.GetKeyValue('settings','ModHosts'));
if (IsModHosts = 1) then
begin
HostsLines:= TStringList.Create;
HostsLines:= List.GetFSection('hosts');
try
ModHosts(HostsLines);
finally
HostsLines.Free;
end;
end;
USelfParam:= List.GetFSection('self')[0];
if(USelfParam<>'FAIL') then SelfUpdate(USelfParam);
CFiles:=List.GetFSection('files_critical');
CheckFiles(CFiles);
CFiles.Free;
if (CForceCheck) or (TRev>CRevision) then
begin
if (CBackup=1) then
begin
DelDir(Dir+'backup');
MkDir(Dir+'backup');
end;
NFiles:=TStringList.Create;
NFiles:=List.GetFSection('files_normal');
CheckFiles(NFiles);
NFiles.Free;
end;
GetFiles;
List.Destroy;
FilesToGet.Free;
DeleteFile(Dir+'files.lst');
if TRev>CRevision then
begin
CRevision:=TRev;
Synchronize(UpdateRevision);
end;
end;
end
else
begin
STemp:='Update Failed';
DeleteFile(Dir+'files.lst');
end;
Synchronize(UpdateStatusLabel);
Synchronize(UNLockFMain);
end;
end.

function CanConnect(const aUserName, aPassword, aHost: String; out aErrm: string): boolean;
var
LocalIDFTP: TIdFTP;
begin
aErrm := '';
LocalIDFTP := TIdFTP.Create(nil);
try
LocalIDFTP.UserName := aUserName;
LocalIDFTP.Password := aPassword;
LocalIDFTP.Host := aHost;
LocalIDFTP.Passive := True;
try
LocalIDFTP.Connect;
LocalIDFTP.Quit;
result := true;
except
on E: Exception do
begin
aErrm := 'Unable to connect to FTP site: ' + E.Message;
Result := FALSE;
end;
end;
finally
if Assigned(LocalIDFTP) then
LocalIDFTP.Free
else
Result := FALSE;
end;
end; {CanConnect}

Send message via TCP in Delphi 7

I have been trying to send message on tcp, but these code seems to give strange error on Delphi 7, thou I tried similar code on Delphi XE and it works fine. Im using Indy 10 on both XE and Delphi 7.
type
TClient = class(TIdContext)
PeerIP : String;
RcvdMsg : String;
procedure SendResponse(const AResponse: String);
end;
...
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
NewClient: TClient;
begin
with TClient(AContext) do
begin
NewClient.PeerIP := Connection.Socket.Binding.PeerIP;
NewClient.RcvdMsg := Connection.Socket.ReadLn;
end;
end;
...
procedure TForm1.BitBtn1Click(Sender: TObject);
var
Context: TClient;
List: TList;
I: Integer;
begin
List := IdTCPServer1.Contexts.LockList;
try
for I := 0 to List.Count-1 do
begin
Context := TClient(List[I]);
MessageBox(0,pChar(Context.PeerIP),0,0); // shows wierd string
(* if (Context.PeerIP = IP) then
begin
//didn't get to here
Context.SendResponse('msg');
Break;
end *)
end;
finally
IdTCPServer1.Contexts.UnlockList;
end;
end;
Any way to solve it ?
EDIT:
type
TClient = class(TIdServerContext)
PeerIP : String;
RcvdMsg : String;
procedure SendResponse(const AResponse: String);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
IdTCPServer1.Bindings.Add.Port := 1234;
IdTCPServer1.Active := not IdTCPServer1.Active;
IdTCPServer1.ContextClass := TClient;
end;
I still can't send message.
procedure TForm1.BitBtn1Click(Sender: TObject);
var
Context: TClient;
List: TList;
I: Integer;
begin
List := IdTCPServer1.Contexts.LockList;
try
for I := 0 to List.Count-1 do
begin
Context := TClient(List[I]);
MessageBox(0,pChar(Context.PeerIP),0,0); // blank
(* if (Context.PeerIP = IP) then
begin
//didn't get to here
Context.SendResponse('msg');
Break;
end *)
end;
finally
IdTCPServer1.Contexts.UnlockList;
end;
end;

TClient needs to derive from TIdServerContext, not TIdContext. And make sure you are assigning the TIdTCPServer.ContextClass property before activating the server if you are not already doing so, or else your typecasts will be invalid:
type
TClient = class(TIdServerContext)
...
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
IdTCPServer1.ContextClass := TClient;
...
end;

why warning appears when sending bitmap frame into MemoryStream to client?

Before I explain my problem, I'm sorry for my bad english.
Okay, here my problem. when my Indy server sends bitmap frame to client, always appeared warning like this :
"EAccessViolation at address 004DD42A..."
And error syntax blue highlighted on this :
Athread.Connection.WriteInteger(MemoryStream.Size);
here my source code :
SERVER
procedure TFormHome.TCPServerConnect(AThread: TIdPeerThread);
var
NewClient: PClient;
begin
GetMem(NewClient, SizeOf(TClient));
NewClient.PeerIP := AThread.Connection.Socket.Binding.PeerIP;
NewClient.HostName := GStack.WSGetHostByAddr(NewClient.PeerIP);
NewClient.Connected := Now;
NewClient.LastAction := NewClient.Connected;
NewClient.Thread := AThread;
AThread.Data := TObject(NewClient);
try
Clients.LockList.Add(NewClient);
finally
Clients.UnlockList;
end;
procedure TFormHome.TCPServerExecute(AThread: TIdPeerThread);
var
pesan:string;
begin
pesan:=Athread.Connection.ReadLn;
if pesan = 'video' then
begin
Athread.Connection.WriteLn('send');
Timer1.Enabled:=true;
FormStream.Show;
Athread.Connection.WriteInteger(MemoryStream.Size);
Athread.Connection.OpenWriteBuffer;
Athread.Connection.WriteStream(MemoryStream);
AThread.Connection.CloseWriteBuffer;
FreeAndNil(MemoryStream);
FormStream.Image1.Picture.Bitmap.Free;
end;
procedure TFormHome.Timer1Timer(Sender: TObject);
begin
pic := TBitmap.Create;
MemoryStream:=TMemoryStream.Create;
VideoGrabber.GetBitmap(FormStream.image1.Picture.Bitmap);
pic := FormStream.Image1.Picture.Bitmap;
pic.SaveToStream(MemoryStream);
//Pic.Free;
//FreeAndNil(Pic);
end;
CLIENT
procedure TFormClient.TCPClientConnected(Sender: TObject);
var
pesan : string;
begin
IncomingMessages.Lines.Insert(0,'Connected to Server');
TCPClient.WriteLn('video');
pesan := TCPClient.ReadLn;
if pesan = 'send' then Timer1.Enabled:=true;
end;
procedure TFormClient.Timer1Timer(Sender: TObject);
var
Size : integer;
ReadStream : TMemoryStream;
begin
ReadStream := TMemoryStream.Create;
Size := TCPClient.ReadInteger;
TCPClient.ReadStream(ReadStream,Size,True);
Image1.Picture.Bitmap.LoadFromStream(ReadStream);
Image1.Picture.Bitmap.Free;
FreeAndNil(ReadStream);
end;
what's wrong witha my code? i need your help.
Thank you before.. ^^

You are trying to send the TMemoryStream before it has even been created. You can't use TTimer or TForm in a worker thread (which OnExecute is called in). Even if you could, when TTimer is enabled, its OnTimer event is not triggered immediately, but your code is expecting it to be.
You need to re-write your code to delegate all UI work to the main thread, where it belongs. Try something more like this:
Server:
Uses
..., IdSync;
type
TVideoStartNotify = class(TIdNotify)
protected
procedure DoNotify; override;
public
Thread: TIdPeerThread;
end;
procedure TFormHome.TCPServerDisconnect(AThread: TIdPeerThread);
begin
TIdNotify.NotifyMethod(VideoStop);
end;
procedure TFormHome.TCPServerExecute(AThread: TIdPeerThread);
var
pesan: string;
begin
pesan := AThread.Connection.ReadLn;
if pesan = 'videostart' then
begin
AThread.Connection.WriteLn('send');
with TVideoStartNotify.Create do
begin
Thread := AThread;
Notify;
end;
end
else if pesan = 'videostop' then
begin
AThread.Connection.WriteLn('stop');
TIdNotify.NotifyMethod(VideoStop);
end;
end;
procedure TVideoStartNotify.DoNotify;
begin
FormHome.VideoStart(Thread);
end;
procedure TFormHome.VideoStart(AThread: TIdPeerThread);
begin
ThreadToSendTo := AThread;
Timer1.Enabled := true;
FormStream.Show;
end;
procedure TFormHome.VideoStop;
begin
ThreadToSendTo := nil;
Timer1.Enabled := false;
FormStream.Hide;
end;
procedure TFormHome.Timer1Timer(Sender: TObject);
var
pic: TBitmap;
MemoryStream: TMemoryStream;
begin
if ThreadToSendTo = nil then
begin
Timer1.Enabled := False;
Exit;
end;
pic := FormStream.Image1.Picture.Bitmap;
try
MemoryStream := TMemoryStream.Create;
try
VideoGrabber.GetBitmap(pic);
pic.SaveToStream(MemoryStream);
try
ThreadToSendTo.Connection.WriteStream(MemoryStream, True, True);
except
ThreadToSendTo := nil;
Timer1.Enabled := False;
end;
finally
MemoryStream.Free;
end;
finally
FormStream.Image1.Picture := nil;
end;
end;
Client:
Uses
..., IdSync;
type
TLogNotify = class(TIdNotify)
protected
procedure DoNotify; override;
public
Msg: String;
end;
procedure TLogNotify.DoNotify;
begin
FormClient.LogMsg(Msg);
end;
procedure TFormClient.Button1Click(Sender: TObject);
begin
TCPClient.Connect;
end;
procedure TFormClient.Button2Click(Sender: TObject);
begin
try
TCPClient.WriteLn('videostop');
finally
TCPClient.Disconnect;
end;
end;
procedure TFormClient.TCPClientConnected(Sender: TObject);
var
pesan : string;
begin
with TLogNotify.Create do
begin
Msg := 'Connected to Server';
Notify;
end;
TCPClient.WriteLn('videostart');
pesan := TCPClient.ReadLn;
if pesan = 'send' then
TIdNotify.NotifyMethod(VideoStart);
end;
procedure TFormClient.TCPClientDisconnected(Sender: TObject);
begin
with TLogNotify.Create do
begin
Msg := 'Disconnected from Server';
Notify;
end;
TIdNotify.NotifyMethod(VideoStop);
end;
procedure TFormClient.LogMsg(const AMsg: string);
begin
IncomingMessages.Lines.Insert(0, AMsg);
end;
procedure TFormClient.VideoStart;
begin
Timer1.Enabled := true;
end;
procedure TFormClient.VideoStop;
begin
Timer1.Enabled := false;
Image1.Picture := nil;
end;
procedure TFormClient.Timer1Timer(Sender: TObject);
var
ReadStream : TMemoryStream;
begin
ReadStream := TMemoryStream.Create;
try
TCPClient.ReadStream(ReadStream, -1, False);
ReadStream.Position := 0;
Image1.Picture.Bitmap.LoadFromStream(ReadStream);
finally
ReadStream.Free;
end;
end;

ini file section to stringgrid

Could someone know / give me an example of how to read a section from an ini file into a stringGrid? As I am struggling to figure out how to do it.
thanks
Colin

You are better to use TValueListEditor to show a section of an ini-file.
Here is a simple demo code:
procedure TForm1.Button1Click(Sender: TObject);
var
SL: TStrings;
IniFile: TMemIniFile;
begin
SL:= TStringList.Create;
try
IniFile:= TMemIniFile.Create('test.ini');
try
IniFile.ReadSectionValues('FOLDERS', SL);
ValueListEditor1.Strings.Assign(SL);
finally
IniFile.Free;
end;
finally
SL.Free;
end;
end;

OTOMH:
procedure ReadIntoGrid(const aIniFileName, aSection: string; const aGrid: TStringGrid);
var
Ini: TIniFile;
SL: TStringList;
i: Integer;
begin
SL := TStringList.Create;
try
Ini := TIniFile.Create(aIniFileName);
try
aGrid.ColCount := 2;
Ini.ReadSectionValues(aSection, SL);
aGrid.RowCount := SL.Count;
for i := 0 to SL.Count - 1 do
begin
aGrid.Cells[0,i] := SL.Names[i];
aGrid.Cells[1,i] := SL.ValueFromIndex[i];
end;
finally
Ini.Free;
end;
finally
SL.Free;
end;
end;
EDIT
The other way round:
procedure SaveFromGrid(const aIniFileName, aSection: string; const aGrid: TStringGrid);
var
Ini: TIniFile;
i: Integer;
begin
Ini := TIniFile.Create(aIniFileName);
try
for i := 0 to aGrid.RowCount - 1 do
Ini.WriteString(aSection, aGrid.Cells[0,i], aGrid.Cells[1,i]);
finally
Ini.Free;
end;
end;

Resources