fajo

Continua na mesma! E acho que TRzGroupItem é um componente senão o TMenuItem também não seria

Obrigado Micheus, pela dica, value mesmo, e a você Churc, também meu muito obrigado, o problema agora é que acho que a classe não está sendo reconhecida, vou colocar o procedimento todo: Procedure TDMAutenticacao.AutenticaMenus(IdSistema, IdUsuario: Integer; Form : TForm); Var I : Integer; Begin With cdsPermissoes Do Begin If Active Then Close; Params.ParamByname('IdUsuario').Value := IdUsuario; Params.ParamByname('IdSistema').Value := IdSistema; Open; For I := 0 To Form.ComponentCount - 1 Do Begin If (Form.Components Is TMenuItem) Then (Form.Components As TMenuItem).Enabled := (Locate('IdItem', (Form.Components As TMenuItem).Tag, [])) Or ((Form.Components As TMenuItem).Tag = 0); If (Form.Components Is TSpeedButton) Then (Form.Components As TSpeedButton).Enabled := (Locate('IdItem', (Form.Components As TSpeedButton).Tag, [])) Or ((Form.Components As TSpeedButton).Tag = 0); If (Form.Components.ClassName = 'TRzGroupItem') Then TRzGroupItem(Form.Components).Enabled := (Locate('IdItem', TRzGroupItem(Form.Components).Tag, [])) Or (TRzGroupItem(Form.Components).Tag = 0); End; Close; End; End; quando o item é um menu ele entra no 1º if habilitando ou desabilitando os menus, quando o item é um SpeedButton, ele entra no 2º if, habilitando ou desabilitando os botões, mas, não entra no 3º if, como se não tivesse esse componente!!! alguma sugestão? Obrigado

Churc, acho que está no caminho certo no código: If (Form.Components Is TRzGroupItem) Then (Form.Components As TRzGroupItem).Enabled :=(Locate('IdItem', (Form.Components As TRzGroupItem).Tag, [])) Or ((Form.Components As TRzGroupItem).Tag = 0); o erro : [DCC Error] UDMAutenticacao.pas(68): E2010 Incompatible types: 'TRzGroupItem' and 'TComponent' acontece 3 vezes, ou seja onde tem "Form.Components Is TRzGroupItem","Form.Components As TRzGroupItem","Form.Components As TRzGroupItem" já no seu código: If (Form.Components Is TRzGroupItem) Then TRzGroupItem(Form.Components).Enabled := (Locate('IdItem', TRzGroupItem(Form.Components).Tag, [])) Or (TRzGroupItem(Form.Components).Tag = 0); só acontece um erro: [DCC Error] UDMAutenticacao.pas(68): E2010 Incompatible types: 'TRzGroupItem' and 'TComponent' e é exatamente na 1ª linha, onde tem: Form.Components Is TRzGroupItem; tá perto!!!!

Olá, eu tenho uma rotina que uso pra desabilitar ou habilitar os botões de acesso aos forms de acordo com as permissões do usuário que é assim: If (Form.Components Is TSpeedButton) Then (Form.Components As TSpeedButton).Enabled := (Locate('IdItem', (Form.Components As TSpeedButton).Tag, [])) Or ((Form.Components As TSpeedButton).Tag = 0); só que estou querendo trocar os botões e menus por um componente Raize, o RzGroup, e o código segue a mesma lógica: If (Form.Components Is TRzGroupItem) Then (Form.Components As TRzGroupItem).Enabled := (Locate('IdItem', (Form.Components As TRzGroupItem).Tag, [])) Or ((Form.Components As TRzGroupItem).Tag = 0); só que na hora da compilação dá o seguinte erro: [DCC Error] UDMAutenticacao.pas(68): E2010 Incompatible types: 'TRzGroupItem' and 'TComponent' porque que ocorre o erro com o RzGroupItem e com o SpeedButtom não? e como corrigí-lo? Obrigado

Bom, tive um problema com meu hd então resolvi instalar o Windows Vista, e após, o meu programa de trabalho, Delphi 2007, instalou numa boa, mas ao tentar executar uma de minhas aplicações, ele dá um erro na dbxint30.dll, ele não consegue encontrar essa dll, mesmo ela estando na pasta bin, dizendo inclusive na mensagem de erro que talvez não esteja no path do sistema, só que eu já olhei e está, então, que compatibilidade é essa? Obrigado!!

Resolvido Micheus, naquel código que você deu: conEleitor.Connected := False; conEleitor.Params.Clear; conEleitor.Params.LoadFromFile(extractfilepath(application.exename)+'configbd.ini'); conEleitor.Params.Add('Password=masterkey'); conEleitor.Connected := True; falei que tava dando erro de Missing Database Property, ai mudei o LoadFromFile por LoadParamsFromIniFile e funcionou bacana: conEleitor.Connected := False; conEleitor.Params.Clear; conEleitor.LoadParamsFromIniFile(extractfilepath(application.exename)+'configbd.ini'); conEleitor.Params.Add('Password=masterkey'); conEleitor.Connected := True; Obrigado a todos

Micheus o valor do parâmetro Database assim como os outros, são pegos do arquivo ini, e tá tudo certo, tanto é que se eu abrir o programa no D2006, funciona perfeitamente; Olha só o conteudo de dois arquivos gerados, um antes do repasse de parametros e outro depois: Antes: [TESTE] DriverName=Interbase DriverUnit=DBXDynalink DriverPackageLoader=TDBXDynalinkDriverLoader DriverPackage=DBXCommonDriver110.bpl DriverAssemblyLoader=Borland.Data.TDBXDynalinkDriverLoader DriverAssembly=Borland.Data.DbxCommonDriver,Version=11.0.5000.0,Culture=neutral,PublicKeyToken=a91a7c5705831a4f Database= RoleName=RoleName User_Name=sysdba Password=masterkey ServerCharSet= SQLDialect=3 BlobSize=-1 CommitRetain=False WaitOnLocks=True ErrorResourceFile= LocaleCode=0000 Interbase TransIsolation=ReadCommited Trim Char=False Depois: [TESTE] DriverName=Interbase DriverUnit=DBXDynalink DriverPackageLoader=TDBXDynalinkDriverLoader DriverPackage=DBXCommonDriver110.bpl DriverAssemblyLoader=Borland.Data.TDBXDynalinkDriverLoader DriverAssembly=Borland.Data.DbxCommonDriver,Version=11.0.5000.0,Culture=neutral,PublicKeyToken=a91a7c5705831a4f Database=J:\Sistemas\Eleitor\BD\DBELEITOR.FDB RoleName=RoleName User_Name=sysdba Password=masterkey ServerCharSet= SQLDialect=3 BlobSize=-1 CommitRetain=False WaitOnLocks=True ErrorResourceFile= LocaleCode=0000 Interbase TransIsolation=ReadCommited Trim Char=False Password=masterkey

Micheus, tá dando erro de "Missing Database Property", e quando mudo no D2006 o 1º código pelo seu dá o mesmo erro, estranho né? Partindo dessa premissa o código do D2006 deveria funcionar no D2007, mas... Churc, na verdade não há tantas mudanças que justifique o upgrade já, pra mim há mais importante foi a atualização da DBX para a versão 4, com várias melhorias, eu é que gosto de sempre dá uma olhada no novo!

Oi Pessoal, nos meus projetos sempre repasso os parametros ao sqlconnection atraves de um arquivo .ini, cujo conteúdo é: [PROJETO] DriverName=UIB Firebird15 Database=C:\Sistemas\base.FDB RoleName=RoleName User_Name=SYSDBA SQLDialect=3 BlobSize=-1 CommitRetain=False WaitOnLocks=True LocaleCode= ErrorResourceFile= Interbase TransIsolation=Read Commited lc_ctype=WIN1252 TrimChar=False e no evento OnCreate do DataModule: procedure TDMPrincipal.DataModuleCreate(Sender: TObject); var i : integer; teste : TStringList; begin teste := TStringList.Create; teste.LoadFromFile(extractfilepath(application.exename)+'base.ini'); SQLConnection1.Connected := False; SQLConnection1.Params.Clear; for I := 0 to teste.Count - 1 do SQLConnection1.Params.Add(teste.Strings); SQLConnection1.Params.Add('Password=masterkey'); Teste.Free; SQLConnection1.LoginPrompt := False; try SQLConnection1.Connected := True; except begin showmessage('Base de Dados Não Encontrada!'); Application.Terminate; end; end; end; no D2006 funciona perfeitamente, no entanto no D2007 ocorre um erro: "Project Projeto1.exe raised exception class EAccessViolation with message 'Access violation at address 012E216B in module 'dbxint30.dll'.Read of Address 00000000'". o que está acontecendo? e outra, alguém sabe onde estão os arquivos dbxconnections.ini e dbxdrivers.ini usados pelo D2007, ou eles estão com outro nome, eu sei que o DBExpress mudou sua versão, mas... Muito Obrigado

Micheus tem como você verificar porque quando se recebe uma mensagem, o usuário que mandou não aparece, só o computador!!!

acho que se aparecer o nome do pc na listagem também, é interessante! Eu também estou pensando em outras implementações, como: quando chegar uma mensagem, deve ser pedida uma senha, para que só a pessoa para quem a mensagem foi enviada possa abri-la,nesse caso devemos fazer um armazenamento com usuario e senha, mas acho que não seja preciso um bd, acho que se trabalharmos com ClientDataSet e arquivos texto criptografados deve dar criados na propria máquina, onde quando o programa abrir deverá verificar se a atual pessoa logada tem um cadastro e se tem uma senha, senão, deverá abrir um pequeno cadastro e ai vai... outra coisa bem interessante é o envio de anexos à mensagem, pense nisso!!! estou esperando o email Té +

Micheus, tá muito muito legal mesmo, mesmo estando no tray ele está relacionando os usuários, - toca o Notify.wav ao entrar um usuário na rede; - abre a tela de mensagem, para resposta, ao receber uma mensagem de outro usuário; tudo tranquilo, exceto, que quando se recebe uma mensagem de um usuário aparece é o nome do PC, pelo menos foi o que deu aqui, se você puder revisar..., mas se não tiver tempo pode me mandar o código que eu tento aqui, você já fez muito, pra não dizer quase tudo!! "Fiz uma alteração no código do TMessenger 2.0, de modo a receber na lista, além do computador (necessário para a comunicação), o nome do usuário que encontra-se logado nesta máquina." só aparece o nome do usuário!!

Fiquei triste, se vou colocar essa rotina em um programa, não posso exigir que todos que se loguem sejam usuários Administradores para usarem esse programa, já que quem não for não terá listado os usuários de outros computadores para poder se comunicarem; será que não tem outra maneira? e agora pouco fiz um teste, tenho 2 pcs aqui, mesmo estando conectado como adminstrador nas duas máquinas em uma consegui listar o nome do pc e o usuário da outra, mas, quando fiz o contrário, deu uma mensagem "Acesso Negado", porque? Já desabilitei firewall e tudo!!!!

Grande Micheus, beleza obrigado pela grande ajuda que você vem me dando; o código do Torry's não funcionou, mas, encontrei um outro: *** CODE START *** unit Example_Unit; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; //Declaration of the returning structures. //These are part of LanMan 2.x and are not supported by Delphi. //Translated from C++ code in the SDK help files. //As you can see we are using lpWStr instead of the C++ lpTStr Type _WKSTA_USER_INFO_0 = Record User_Name : Array[0..255] Of lpWStr; End; Type _WKSTA_USER_INFO_1 = Record User_Name, Logon_Domain, Other_Domains, Logon_Server : Array[0..255] Of lpWStr; End; Type WKSTA_USER_INFO_0 = _WKSTA_USER_INFO_0; WKSTA_USER_INFO_1 = _WKSTA_USER_INFO_1; //Declaration of the Function //Notice the Var clause in front of the pointer. //This means that this is a returning parameter //in addition to the Function Result. Function NetWkstaUserEnum(ServerName : lpWStr; Level : DWord; Var Buffer : Pointer; PrefMaxLen : DWord; Const EntriesRead, TotalEntries, Resume_Handle : lpDWord) : LongInt; StdCall; External 'NETAPI32.DLL'; Function NetApiBufferAllocate(ByteCount : DWord; Buffer : Pointer) : LongInt; StdCall; External 'NETAPI32.DLL'; Function NetApiBufferFree(Buffer : Pointer) : LongInt; StdCall; External 'NETAPI32.DLL'; Type TForm1 = Class(TForm) Button1: TButton; Edit1: TEdit; Label1: TLabel; Memo1: TMemo; procedure Button1Click(Sender: TObject); Private Public //This is useful later to stear our program according to the system versions. Function ReturnSystemVersion : DWord; End; Var Form1: TForm1; Buffer : Pointer; ServerName : Array[0..255] Of Char; EntriesRead, TotalEntries, Resume_Handle : DWord; NET_API_STATUS : LongInt; WKSTA_STRUCT_0 : WKSTA_USER_INFO_0; WKSTA_STRUCT_1 : WKSTA_USER_INFO_1; Implementation {$R *.DFM} //And ofcoarse ... we need som code inside it ... :o) Function TForm1.ReturnSystemVersion : DWord; Begin Result := Win32PlatForm; End; Procedure TForm1.Button1Click(Sender: TObject); Var I : Integer; Begin //We make a case loop to control what we will do. //Since I'm not familiar with other than NT programming, //I'll show you an NT example. Case ReturnSystemVersion Of VER_PLATFORM_WIN32s : Begin //System is Win32s End; VER_PLATFORM_WIN32_WINDOWS : Begin //System is Win95 End; VER_PLATFORM_WIN32_NT : Begin //System is WinNT Memo1.Lines.Clear; StringToWideChar(Edit1.Text,@ServerName,256); //Convert the string to UNICode VERY IMPORTANT ! Resume_Handle := 0; //This must be 0 in the first call. NET_API_STATUS := NetWkstaUserEnum(@ServerName,0,Buffer,SizeOf(WKSTA_USER_INFO_0),@EntriesRead,@TotalEntries,@Resume_Handle); If NET_API_STATUS = 0 Then //We don' want to do this if an error occurs, otherwise we get a nasty error message. Begin //Remember to select the CORRECT structure according to your level. WKSTA_STRUCT_0 := WKSTA_USER_INFO_0(Buffer^); //This syntax returns an error if you execute it with an NET_API_STATUS > 0. //And now if youre member of the administrator account ... just watch the wonderful result og API programming.... :o) For I := 0 To EntriesRead - 1 Do Memo1.Lines.Add(WideCharToSTring(WKSTA_STRUCT_0.User_Name)); //Remember to convert from UNICode to String. //Good luck ... and pls. mail me if you have firther questions... ;o) End Else ShowMessage(SysErrorMessage(NET_API_STATUS)); End; End; End; End. *** CODE END *** caiu como uma luva, me retorna tanto o nome da máquina como o usuário, agora, você me disse em outra oportunidade que só poderia ser executado pelo Administrador, ainda continua sua afirmação? porque se sim, volto a estaca zero;

é exatamente como você disse, quando está minimizada no tray a rotina OnUserListChange não é executada, acho que vou desistir disso, como você mesmo disse não tem como manter o foco em uma aplicação minimizada, se você puder me fazer mais um favor, analisar o código mais acima e me dizer onde é que ele pega os computadores da rede, porque a unica coisa que eu vi foi GetComputerName e até onde sei isso pega o nome do computador local e a rotina que faz isso é: Procedure TMainMessenger.SendCommand(Recipient,Command : string); begin Outstrings.Add('COMMAND_MSG'); Outstrings.Add(TimeToStr(Time)); OutStrings.Add(FComputer); OutStrings.Add(Command); OutStrings.Add('END_MESSAGE'); SendOutStrings(Recipient); end; tem essa variável FComputer; e apesar de ter também uma FUser que teoricamente serviria pra pegar os usuários em vez dos nomes dos computadores, quando eu substituo ela retorna é o nome do usuário local!!! Por favor, preciso muito disso!! Obrigado

Oi pessoal, estou precisando de uma rotina que me retorne num listbox por exemplo todos os usuarios conectados nos computadores da minha rede!! Obrigado

Tem sim Micheus, as duas, tá ai: procedure TfrmMain.ICQFmsgNewLine(Sender: TObject; Origin, Time, Line: String); begin frmReceive := TfrmReceive.Create(Application); frmReceive.Caption := Origin; frmReceive.mmoReceive.Text := Line; frmReceive.ShowModal; frmReceive.Free; end; procedure TfrmMain.ICQFmsgNewMemo(Sender: TObject; Origin, Time: String; MsgLines: TStrings); begin frmReceive := TfrmReceive.Create(Application); frmReceive.Caption := Origin; frmReceive.mmoReceive.Lines := MsgLines; Beep; frmReceive.ShowModal; frmReceive.Free; end;

Não usei nenhum banco de dados e o código da rotina é esse: procedure TfrmMain.ICQFmsgUserListChange(Sender: TObject; UserList: TStrings); begin lbxUser.Items := UserList; //captura todos os usuários onLine end; onde ICQFmsg é o nome dado ao componente TMessenger, cuja Unit é: unit Messenger; interface {$LONGSTRINGS ON} // Equal {$H+} uses ExtCtrls, Windows, SysUtils, Classes,Dialogs; type TMainMessenger = Class; TSignalThread = class(TThread) private FMailSlot : TMainMessenger; protected procedure Execute; override; Public Constructor Create(MailSlot : TMainMessenger); end; TTimerThread = class(TThread) private FMailSlot : TMainMessenger; protected procedure Execute; override; Public Constructor Create(MailSlot : TMainMessenger); end; TNELineArrival = Procedure (Sender : TObject;Origin,Time,Line : string) of Object; TNEMemoArrival = Procedure (Sender : TObject;Origin,Time : string;MsgLines : TStrings) of Object; TNEUserListChange = Procedure (Sender : TObject; UserList : TStrings) of Object; TNEError = Procedure (Sender : TObject;ErrorMsg : string) of object; TNETimer = Procedure (Sender : TObject) of object; TMainMessenger = class(TComponent) private FWaitThread : TSignalThread; FTimerThread : TTimerThread; LocalHandle,RemoteHandle : THandle; ActiveFlag : Boolean; FComputer,FUser : string; Server,FBoxName,LocalPath,RemotePath : string; MaxMsgSize,MsgCount,NextMsgSize,MsgSize : DWORD; MsgType,MsgTime,MsgSender,MsgText : string; OutStrings,InStrings,UserList,MemoLines : TStringList; NewLine : String; FInterval : word; FTimerActive : boolean; FLineArrival : TNELineArrival; FMemoArrival : TNEMemoArrival; FUserListChange : TNEUserListChange; FError : TNEError; FTimer : TNETimer; Procedure SendOutStrings(Recipient : string); Procedure SendCommand(Recipient,Command : string); Procedure AddUser(Name : string); Procedure DeleteUser(Name : string); protected Procedure DoLineArrival(Const FMSender,FMTime,FMText : string); virtual; Procedure DoMemoArrival(const FMSender,FMTime : string;MLines : Tstrings); virtual; Procedure DoUserListChange(Const CompList : TStringList); virtual; Procedure DoErrorReport(const Error : string); virtual; public Constructor Create(AOwner : TComponent); Override; Destructor Destroy; override; Procedure Activate; Procedure DeActivate; Procedure SetName(const NewName : TComponentName); override; Procedure SetBoxName(NewName : string); Procedure SetInterval(time : word); Procedure ReadMessage; Procedure ProcessCommand; Procedure SendLine(Recipient,Text : string); Procedure SendMemo(Recipient : string;Lines : TStrings); Procedure Broadcast(text : string); procedure DoTimer; Property OnNewLine : TNELineArrival read FLineArrival write FLineArrival; Property OnNewMemo : TNEMemoArrival read FMemoArrival write FMemoArrival; Property OnUserListChange : TNEUserListChange Read FUserListChange Write FUserListChange; Property OnError : TNEError read FError write FError; Property OnTimer : TNETimer read FTimer write FTimer; published end; TMessenger = class(TMainMessenger) Published Property Computer : string read FComputer; Property User : string read FUser; Property BoxName : string read FBoxName write SetBoxName; Property Interval : word read FInterval write SetInterval; Property OnNewLine; Property OnNewMemo; Property OnUserListChange; Property OnError; Property OnTimer; end; procedure Register; implementation //---------- Component Registration ------------------------------------------ procedure Register; begin RegisterComponents('3rdParty', [TMessenger]); end; //---------- Thread Procedures ----------------------------------------------- Constructor TSignalThread.Create(MailSlot : TMainMessenger); Begin Inherited Create(False); Priority := tpNormal; FMailSlot := MailSlot; end; Procedure TSignalThread.Execute; Begin While Not Terminated do Begin GetMailSlotInfo(FMailSlot.LocalHandle,NIL, FMailSlot.NextMsgSize, @FMailSlot.MsgCount, NIL); If FMailSLot.MsgCount > 0 Then Synchronize(FMailSLot.ReadMessage); Sleep(1); end; end; Constructor TTimerThread.Create(MailSlot : TMainMessenger); Begin Inherited Create(False); Priority := tpNormal; FMailSlot := MailSlot; end; Procedure TTimerThread.Execute; Begin While Not Terminated do begin Synchronize(FMailSLot.DoTimer); Sleep(FMailslot.FInterval); end; end; Procedure TMainMessenger.DoTimer; begin if assigned(FTimer) then FTimer(Self); end; //----------- Signaler StartUp/ShutDown ----------------------------------------- Constructor TMainMessenger.Create(AOwner : TComponent); var temp : array[0..255] of char; len : DWord;//integer; Begin Inherited Create(AOwner); FBoxName := 'SignalBox'; FInterval := 1000; FWaitThread := NIL; FTimerThread := NIL; len := 255; GetComputerName(temp,len); FComputer := StrPas(temp); len := 255; GetUserName(temp,len); FUser := StrPas(temp); OutStrings := TStringList.Create; InStrings := TStringList.Create; UserList := TStringList.Create; MemoLines := TStringList.Create; end; Destructor TMainMessenger.Destroy; begin if ActiveFlag = true then DeActivate; UserList.Free; OutStrings.Free; InStrings.Free; MemoLines.Free; inherited Destroy; end; Procedure TMainMessenger.Activate; var i,j : integer; begin If ActiveFlag = true then begin DoErrorReport('You tried to Activate an active TMessenger component'); exit; end; FWaitThread := TSignalThread.Create(Self); if FWaitThread = nil then begin DoErrorReport('Could not Start TMessenger Timer Thread'); exit; end; FTimerThread := TTimerThread.Create(Self); Server := '.'; LocalPath := '\\' + Server + '\mailslot\' + FBoxName; LocalHandle := CreateMailSlot(PChar(LocalPath),MaxMsgSize,0,nil); if LocalHandle = INVALID_HANDLE_VALUE then begin FWaitThread.Terminate; FWaitThread := nil; FTimerThread.Terminate; FTimerThread := nil; DoErrorReport('Could not Create Mail Slot'); exit; end; SendCommand('*','ONLINE_NOTIFY'); ActiveFlag := true; end; Procedure TMainMessenger.DeActivate; begin if ActiveFlag = false then begin DoErrorReport('Cannot Deactivate an Inactive TMessenger Component'); exit; end; if FWaitThread <> nil then begin FWaitThread.Terminate; FWaitThread := nil; end; if FTimerThread <> nil then begin FTimerThread.Terminate; FTimerThread := nil; end; CloseHandle(LocalHandle); SendCommand('*','OFFLINE_NOTIFY'); ActiveFlag := False; end; //-------------- Set Property Procedures -------------------------------------- Procedure TMainMessenger.SetName(const NewName: TComponentName); Begin Inherited SetName(NewName); end; Procedure TMainMessenger.SetBoxName(NewName : string); begin if FBoxName <> NewName then begin FBoxName := NewName; if ActiveFlag = true then begin DeActivate; Activate; end; end; end; Procedure TMainMessenger.SetInterval(Time : word); begin if FInterval <> Time then FInterval := Time; end; //------------- Message Retrieval Procedures ---------------------------------- Procedure TMainMessenger.ReadMessage; var i : integer; begin Instrings.Clear; SetLength(NewLine,NextMsgSize); ReadFile(LocalHandle,PChar(NewLine)^,NextMsgSize,MsgSize,nil); Instrings.Text := NewLine; FWaitThread.Suspend; if Instrings.Count > 3 then begin MsgType := Instrings[0]; MsgTime := Instrings[1]; MsgSender := Instrings[2]; MsgText := Instrings[3]; end; if Instrings.Count > 5 then begin MemoLines.Clear; for i := 4 to Instrings.Count - 2 do begin MemoLines.Add(Instrings); end; end; if MsgType = 'COMMAND_MSG' then ProcessCommand; if MsgType = 'LINE_MSG' then DoLineArrival(MsgSender,MsgTime,MsgText); if MsgType = 'MEMO_MSG' then DoMemoArrival(MsgSender,MsgTime,MemoLines); Instrings.Clear; FWaitThread.Resume; end; Procedure TMainMessenger.ProcessCommand; begin if MsgSender = FComputer then exit; if MsgText = 'ONLINE_NOTIFY' then begin AddUser(MsgSender); SendCommand(MsgSender,'ONLINE_RESPONSE'); end; if MsgText = 'ONLINE_RESPONSE' then AddUser(MsgSender); if MsgText = 'OFFLINE_NOTIFY' then DeleteUser(MsgSender); end; Procedure TMainMessenger.AddUser(Name : string); var i : Integer; j : boolean; begin j := false; if UserList.Count > 0 then begin for i := 0 to UserList.Count - 1 do begin if UserList = Name then j := true; end; end; if j = true then exit; UserList.Add(Name); DoUserListChange(UserList); end; Procedure TMainMessenger.DeleteUser(Name : string); var i,Num : Integer; j : boolean; begin j := false; Num := 0; if UserList.Count > 0 then begin for i := 0 to UserList.Count - 1 do begin if UserList = Name then begin j := true; Num := i; end; end; end; if j = false then exit; UserList.Delete(Num); DoUserListChange(UserList); end; //------------- Message Sending Procedures ------------------------------------ Procedure TMainMessenger.SendOutStrings(Recipient : string); var len : DWORD; begin if OutStrings.Count > 0 then begin RemotePath := '\\' + Recipient + '\mailslot\' + FBoxName; RemoteHandle := CreateFile(PChar(RemotePath),GENERIC_WRITE,FILE_SHARE_READ, nil,CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,0); if RemoteHandle = INVALID_HANDLE_VALUE then begin DoErrorReport('Could not Open a Remote Mail Slot'); exit; end; WriteFile(RemoteHandle,Pointer(Outstrings.text)^,Length(OutStrings.text),len,nil); OutStrings.Clear; end; end; Procedure TMainMessenger.SendLine(Recipient,Text : string); begin if Recipient = '*' then exit; Outstrings.Add('LINE_MSG'); Outstrings.Add(TimeToStr(Time)); OutStrings.Add(FComputer); OutStrings.Add(text); OutStrings.Add('END_MESSAGE'); SendOutStrings(Recipient); end; Procedure TMainMessenger.Broadcast(text : string); begin Outstrings.Add('LINE_MSG'); Outstrings.Add(TimeToStr(Time)); OutStrings.Add(FComputer); OutStrings.Add(text); OutStrings.Add('END_MESSAGE'); SendOutStrings('*'); end; Procedure TMainMessenger.SendMemo(Recipient : string;Lines : TStrings); var i : integer; begin if Recipient = '*' then exit; Outstrings.Add('MEMO_MSG'); Outstrings.Add(TimeToStr(Time)); OutStrings.Add(FComputer); OutStrings.Add('BEGIN_MEMO'); if Lines.Count > 0 then begin for i := 0 to Lines.Count -1 do begin OutStrings.Add(Lines); end; end; OutStrings.Add('END_MESSAGE'); SendOutStrings(Recipient); end; Procedure TMainMessenger.SendCommand(Recipient,Command : string); begin Outstrings.Add('COMMAND_MSG'); Outstrings.Add(TimeToStr(Time)); OutStrings.Add(FComputer); OutStrings.Add(Command); OutStrings.Add('END_MESSAGE'); SendOutStrings(Recipient); end; //----------- Event Handler Procedures --------------------------------------- Procedure TMainMessenger.DoLineArrival(const FMSender,FMTime,FMText : string); begin if Assigned(FLineArrival) then FLineArrival(Self,MsgSender,MsgTime,MsgText); end; Procedure TMainMessenger.DoMemoArrival(const FMSender,FMTime : string;MLines : Tstrings); begin if Assigned(FMemoArrival) then FMemoArrival(Self,MsgSender,MsgTime,MemoLines); end; Procedure TMainMessenger.DoUserListChange(Const CompList : TStringList); begin If Assigned(FUserListChange) Then FUserListChange(Self,CompList); end; Procedure TMainMessenger.DoErrorReport(const Error : string); begin If Assigned(FError) Then FError(Self,Error); end; end.

Bom Micheus, como eu disse anteriormente, estou fazendo um programinha de mensagens pra rede local, a minha intenção é que ele inicie com o windows e vá direto para o Tray, até que alguém dê clique duplo, selecione um usuário pra enviar uma mensagem, o problema que eu detectei é que a rotina responsável por coletar as informações dos outros computadores da rede que tem o programa instalado para que sejam listados no listbox, só é executada quando o form é..., até meio complicado explicar, acho que quando ele é focado, tipo assim, quando eu disabilito a iniciação no tray, ou seja, quando ele é executado como outro programa a rotina é lida e a coleta das informações é feita, eu fiz um teste aqui colocando uma animação no form "AnimateWindow(Handle, 3000, AW_BLEND);", beleza, o form é aberto só que sem foco ai só é eu clicar e pronto as outras aplicações irmãs passam a vê-la, meu intuito é exatamente isso fazer com a aplicação receba o foco mesmo no tray pra ativar a rotina!! Se quiser posso te mandar o código e o componente pra dar uma olhada beleza

Oi pessoal, Existe alguma forma de ativar uma aplicação que está no tray, eu só quero que ela receba o foco, ela inicia minizada no tray e eu quero que ela receba o foco, tipo setfocus que não serve pois o mainform está oculto; Obrigado

Vacilo meu Micheus, ignore a resposta!!! Desculpa

Oi Micheus, beleza cara fiz o que você disse e tá dando um erro "Invalid class typecast" o que será?

Estou aprimorando um programa de Mensagens pela rede interna e preciso tirar algunas dúvidas; quando o programa é executado ele já detecta em outros computadores da rede que tem o programa rodando e ai já coloca o nome do pc no listbox, cujo procedimento é: procedure Tform.MessageUserListChange(Sender: TObject; UserList: TStrings); var i: string; begin Listbox1.Items := UserList; //captura todos os usuários onLine end; as dúvidas são: 1. Como colocar uma imagem antes de cada item; 2. É possível aumentar o espaço entre os itens; Obrigado