Rento
-
Total de itens
22 -
Registro em
-
Última visita
Posts postados por Rento
-
-
Cria um serviço no servidor para que cheque quanto estão online(o proprio mysql) se o select retornar mais que 5 você bloqueia uma chave, ou algo do genero, se estava 5 e volto pra 4 você libera.
-
E se eu fazer pelo CMD?
Aposto que ele não vai pegar não é?
Não é mais fácil bloquear o usuario não?
digita no CMD:
cd c:\
cd c:\arquvivos de programas\
dir
ai já ta tudo, já da pra da um del *.*(mesmo não funcionando em todos arquivos)
//.
Sobre as APIs do windows... se bobiar esses programas usam os comandos da "lista negra". Igual o KillBox.
-
Ola gente, se alguém usa lua, sabe que tem o comando lua_getPointer, porém eu não sei como setar.
Então usei o integer mesmo.
Ai fiz o seguinte, quando o player entra, da um new(x) sendo que x é um ponteiro inteiro. Se eu coloco Integer(^x) funciona.
E outra duvida, mesmo se eu colocar Integer(^x) como faria para ele volotar a ser pointer? Pointer(123)?
Ah, se alguém quiser o código que eu editei(o exemplo é muito ruin, ai juntei o exemplo com um bom que achei na net) so falar!
Parte banner:
Se programa em lua:
http://otsadmin.hyperphp.com/feature.php?lang=1
Aquela ferramenta para jogo não precisa ser usada ^^
-
Outra dica, como fazer uma progressbar com Query:
* Não é necessário o uso do Timer.
Inicia o valor no 0
Quando abir a query passa um pedacinho(até porque mesmo a mais complexa query executa rapidamente)
dê um count e coloque como máximo do timer.
Progressbar1.Max := Query1.RecordCount;
enquanto estiver no while not QUERY.eof do coloque pb.stepby(1); (não se esquesa do processsmessage, nem do QUERY.next)
se quiser cancelar. troca o while not QUERY.eof do por while (not QUERY.eof) and (cont) do com uma variavel cont boolean, se setada para false para. Se colocar num botão poderá testar ^^
-
Valeu ae;
Quando tiver mais acordado(fui dormi as 4) eu posto os codigos modificados.
Sobre o free, vou por um if.
li um site todo(em ingles, mas ta bom) é o DelphiBasics, la tem tudo(espero eu) sobre as classes...
-
Nossa cara, essa ai do -1 foi muito bem pensada ^^ valeu!
Já sobre o inherited, eu não usei TX = Class(TSocket), criei por fora. Então não tem porque usar o inherited, eu acho.
Outra coisa ae pessoal, depois que eu usei.
Se chamar o .destroy, se apos ele der um FreeAndNil buga, é so remove o FREE AND NIL, se esquecer o destroy não vai da free nas listas. E vai bugar.
-
Se ainda não entender
Bota uma variável bollean global
Depois do begin do while bota um if var boll then
e desse begin um app.processmessages
Assim ele processa tudo enquanto ta no loop
Quando fazer esse negocio que você disse ele seta essa variável para False,
lembrasse de setala como true antes do loop
-
Eu vendo controle de ponto, mas como sou bonzinho vou postar:
function fDiasDeAtraso(pData1, pData2: TDate): Integer; var X, Y: Integer; begin X := Trunc(pData1 - pData2); Y := 0; while X > 0 do begin X := X - 1; Y := Y + 1440; end; Result := Y; end; function fMinAtraso(pHrNorm: string): Integer; var lvNormDate: TDate; lvNormTime: TTime; lvTempResult: Integer; begin lvNormDate := StrToDate(fFormat(Copy(pHrNorm, 1, 8), rrDbDate)); lvNormTime := StrToTime(Copy(pHrNorm, 9, 2) + ':' + Copy(pHrNorm, 11, 2)); if (lvNormDate = Date) and (lvNormTime = Time) then lvTempResult := 0 else begin if (lvNormDate = Date) then lvTempResult := fTimeToMin(lvNormTime, Now) else begin if (lvNormDate > Date) then begin lvTempResult := fDiasDeAtraso(lvNormDate, Date); lvTempResult := lvTempResult + fTimeToMin(lvNormTime, Now); end else lvTempResult := -1; end; end; Result := lvTempResult; end; function fMinAntes(pHrNorm: string): Integer; //--------------------------------------------------------------------------- function fTimeToMin2(pMin1, pMin2:ttime): Integer; var lv1, lv2: Integer; //------------------------------------------------------------------------ function fHourToMin(pTime: String): Integer; var lvHour, lvMin, lvIdx : Integer; lvTime : string; begin lvIdx := 3; lvTime := fSomNum(pTime); lvHour := StrToInt(Copy(lvTime, 1 , 2)); lvMin := StrToInt(Copy(lvTime, lvIdx, 2)); Result := ((lvHour * MinsPerHour) + lvMin); end; begin lv1 := fHourToMin(TimeToStr(pMin1)); lv2 := fHourToMin(TimeToStr(pMin2)); Result := (lv2 - lv1); end; //--------------------------------------------------------------------------- var lvNormDate: TDate; lvNormTime: TTime; lvTempResult: Integer; begin lvNormDate := StrToDate(fFormat(Copy(pHrNorm, 1, 8), rrDbDate)); lvNormTime := StrToTime(Copy(pHrNorm, 9, 2) + ':' + Copy(pHrNorm, 11, 2)); if (lvNormDate = Date) then lvTempResult := fTimeToMin2(Now, lvNormTime) else begin if (lvNormDate < Date) then begin lvTempResult := fDiasDeAtraso(Date, lvNormDate); lvTempResult := lvTempResult + fTimeToMin2(Now, lvNormTime); end else lvTempResult := 0; end; Result := lvTempResult; end;
Não me lembro como programei, da uma olhada porque funciona ^^lvAtraso := fMinAtraso(Copy(lvDtEnt, 9, 12)); if (lvAtraso = -1) then begin lvAtraso := fMinAntes(Copy(lvDtEnt, 9, 12)); if (lvPerm_entrada_antes) then begin rSalvaEntradaAdiantada(); rDefEnt(); fmArFrame[lvIndex].lblAviso.Caption := 'Entrou adiantado'; end else begin fmArFrame[lvIndex].lblAviso.Caption := 'Aguarde o horário de entrada'; end; end else begin if (lvAtraso > lvFalta) then begin fmArFrame[lvIndex].lblAviso.Caption := 'ATENÇÂO: Hoje foi considerado falta'; rExecSQL('UPDATE controle SET '+ 'used = 0, saiu = "-1" WHERE entrada = "'+lvDtEnt+'"'); end else begin if (lvAtraso = 0) then begin rDefEnt(); fmArFrame[lvIndex].lblAviso.Caption := 'Entrou'; end else begin rSalvaEntradaAtrasada(); rDefEnt(); fmArFrame[lvIndex].lblAviso.Caption := 'ENTROU ATRASADO: Devendo mais ' + IntToStr(lvAtraso) + ' minutos'; end; end; end; -
-
Após eu passar por dores de cabeças com o TServerSocket e o TClientSocket, fiz está classes.
Ela corrige os principais erros que enfrentei e mais alguns que podem estar acontecendo por ai:
- MensagensComProblamaDeJuntaTudoAndBugarTudo
- Mensagens grandes 100%
- Address com "localhost" auto para 127.0.0.1
Você pode modificar quaisquer arquivo, mantendo por favor o cabeçalho.
Link de tudo:
http://www.myfileupload.net/download.php?f...58d91c2146ebf79
unSocket.pas:
{*----------------------------------------------------------------------------*}
{* Socket Tools v1.0 written by Rento (rento@click21.com.br) ******************}
{*----------------------------------------------------------------------------*}
{* Constants for use with Socket Tools ****************************************}
{*----------------------------------------------------------------------------*}
{* Copyright © 2008 Rento *}
{* Permission is hereby granted, free of charge, to any person obtaining a *}
{* copy of this software and associated documentation files (the "Software"), *}
{* to deal in the Software without restriction, including without limitation *}
{* the rights to use, copy, modify, merge, publish, distribute, sublicense, *}
{* and/or sell copies of the Software, and to permit persons to whom the *}
{* Software is furnished to do so, subject to the following conditions: *}
{* *}
{* The above copyright notice and this permission notice shall be included in *}
{* all copies or substantial portions of the Software. *}
{* *}
{* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR *}
{* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *}
{* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *}
{* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *}
{* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *}
{* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *}
{* DEALINGS IN THE SOFTWARE. *}
{********************************* FUNCTIONS **********************************}
// DAY | Function | Type
// 10/04/2008 create v1 Server
// 10/04/2008 rSendMessage v1 Server
// 10/04/2008 rOnBefRead v1 Server
// 10/04/2008 rChangeActive v1 Server
// 10/04/2008 Destroy v1 Server
//
// 11/04/2008 rSeparateMsg v1 unit
// 11/04/2008 rOnBefRead v2 Server
// 11/04/2008 onLogin v1 Server
// 11/04/2008 onLogout v1 Server
//
// 12/04/2008 rSendText overload v1 Server
// 12/04/2008 rOnBefRead v2 Server
// 12/04/2008 onError v1 Server
// 12/04/2008 create v1 Client
// 12/04/2008 rOnBefRead v1 Client
// 12/04/2008 Destroy v1 Client
// 12/04/2008 rSendMessage v1 Client
// 12/04/2008 onError v1 Client
// Ops! Are 00:03 of 13/04/2008
// 13/04/2008 onConnect v1 Client
{*----------------------------------------------------------------------------*}
unit unSocket;
interface
uses
ScktComp, WinSock, Classes, Windows, forms, SysUtils;
//------------------------------------------------------------------------------
procedure rSeparateMsg(var pLst: TStrings; pMsg: string);
type
{ 10060 | 10061 | 10065, 10064 | 10040 }
TErrorType = (etTimeOut, etRefused, etNoHost, etHostDown, etTooLong, etUnknow);
TRetEvt = procedure(pMessage: string; pFrom: Pointer) of object;
TEtnEvt = procedure(pSocket: TCustomWinSocket) of object;
TGetEvt = procedure(pSocket: TCustomWinSocket; pMsg: string) of object;
TErrEvt = procedure(pSocket: TCustomWinSocket; pErroType: TErrorType; var pErroCode: Integer) of object;
TServer = class
protected
FServer : TServerSocket;
FRetEvt : TRetEvt;
FLogin : TEtnEvt;
FLogout : TEtnEvt;
FLastMsg: string;
FMsgLst : TStrings;
FConIds : TList;
FErrEvt : TErrEvt;
procedure rOnBefRead(Sender: TObject; Socket: TCustomWinSocket);
procedure rOnBefLogin(Sender: TObject; Socket: TCustomWinSocket);
procedure rOnBefLogout(Sender: TObject; Socket: TCustomWinSocket);
procedure rOnBefError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
public
constructor Create(pPort: Integer; const pActive: Boolean = False);
destructor Destroy(); override;
property onExecute: TRetEvt read FRetEvt write FRetEvt;
property onLogin : TEtnEvt read FLogin write FLogin;
property onLogout : TEtnEvt read FLogout write FLogout;
procedure rSendMessage(pIdx: Integer; pMsg: string); overload;
procedure rSendMessage(pData: Pointer; pMsg: string); overload;
procedure rChangeActive(pValor: Boolean);
property onError : TErrEvt read FErrEvt write FErrEvt;
end;
TClient = class
protected
FGetEvt : TGetEvt;
FLastMsg: String;
FMsgLst : TStrings;
FClient : TClientSocket;
FErrEvt : TErrEvt;
FLogin : TEtnEvt;
procedure rOnBefRead(Sender: TObject; Socket: TCustomWinSocket);
procedure rOnBefError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure rOnBefCon(Sender: TObject; Socket: TCustomWinSocket);
public
constructor Create(pIp: string; pPort: Integer; const pActive: Boolean = False);
destructor Destroy(); override;
property onRead : TGetEvt read FGetEvt write FGetEvt;
property onError : TErrEvt read FErrEvt write FErrEvt;
property onConnect: TEtnEvt read FLogin write FLogin;
procedure rSendMessage(pMsg: string);
end;
//------------------------------------------------------------------------------
implementation
constructor TServer.Create(pPort: Integer; const pActive: Boolean = False);
begin
FServer := TServerSocket.Create(nil);
FMsgLst := TStringList .Create;
FConIds := TList .Create;
FServer.Port := pPort;
FServer.OnClientConnect := rOnBefLogin;
FServer.OnClientRead := rOnBefRead;
FServer.OnClientDisconnect := rOnBefLogout;
FServer.OnClientError := rOnBefError;
rChangeActive(pActive);
end;
procedure TServer.rSendMessage(pIdx: Integer; pMsg: string);
var
I: Integer;
begin
if pMsg <> '' then
begin
if pIdx = -1 then
begin
for I := 0 to FServer.Socket.ActiveConnections - 1 do
begin
Application.ProcessMessages; // If ActiveConnections so large...
FServer.Socket.Connections[I].SendText(#0 + pMsg + #0 + 'END');
end;
end
else
begin
if pIdx <= FServer.Socket.ActiveConnections - 1 then
begin
FServer.Socket.Connections[pIdx].SendText(#0 + pMsg + #0 + 'END');
end;
end;
end;
end;
procedure TServer.rSendMessage(pData: Pointer; pMsg: string);
begin
rSendMessage(FConIds.IndexOf(pData), pMsg);
end;
procedure TServer.rOnBefRead(Sender: TObject; Socket: TCustomWinSocket);
var
lvAllRec: Boolean;
lvLength: Integer;
lvRecive: string;
lvAllMsg: string;
I: Integer;
begin
lvRecive := Socket.ReceiveText;
lvLength := Length(lvRecive);
lvAllRec := Copy(lvRecive, lvLength - 2, 3) = 'END';
if lvAllRec then
begin
lvAllMsg := FLastMsg + Copy(lvRecive, 1, lvLength - 3);
rSeparateMsg(FMsgLst, lvAllMsg);
for I := 0 to FMsgLst.Count - 1 do
onExecute(FMsgLst.Strings[I], Socket.Data);
end
else
begin
FLastMsg := FLastMsg + lvRecive;
end;
end;
procedure TServer.rOnBefLogin(Sender: TObject; Socket: TCustomWinSocket);
var
lvP: ^integer;
begin
New(lvP);
Socket.Data := lvP;
FConIds.Add(Socket.Data);
onLogin(Socket);
end;
procedure TServer.rOnBefLogout(Sender: TObject; Socket: TCustomWinSocket);
begin
onLogout(Socket);
FConIds.Remove(Socket.Data);
Dispose(Socket.Data);
end;
procedure rSeparateMsg(var pLst: TStrings; pMsg: string);
var
I: Integer;
lvTmp: String;
begin
lvTmp := '';
I := 1;
pLst.Clear;
while (I <= Length(pMsg)) do
begin
if pMsg[I] = #0 then
begin
Inc(I);
while ((pMsg[I] <> #0) and (I <= Length(pMsg))) do
begin
lvTmp := lvTmp + pMsg[I];
Inc(I);
end;
end;
Inc(I);
if lvTmp <> '' then
pLst.Add(lvTmp);
lvTmp := '';
end;
end;
procedure TServer.rOnBefError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
var
lvEt: TErrorType;
begin
case ErrorCode of
10060: lvEt := etTimeOut;
10061: lvEt := etRefused;
10065: lvEt := etNoHost;
10064: lvEt := etHostDown;
10040: lvEt := etTooLong;
else lvEt := etUnknow;
end;
onError(Socket, lvEt, ErrorCode);
end;
procedure TServer.rChangeActive(pValor: Boolean);
begin
if not pValor then
begin
FLastMsg := '';
FMsgLst.Clear;
FConIds.Clear;
FServer.Close;
end
else
begin
if not FServer.Active then
FServer.Open;
end;
end;
destructor TServer.Destroy();
begin
FMsgLst.Free;
FConIds.Free;
end;
//------------------------------------------------------------------------------
constructor TClient.Create(pIp: string; pPort: Integer; const pActive: Boolean = False);
begin
FLastMsg := '';
FMsgLst := TStringList .Create;
FClient := TClientSocket.Create(nil);
FClient.Port := pPort;
if (LowerCase(pIp) = 'localhost') or (Trim(pIp) = '') then
FClient.Address := '127.0.0.1'
else
FClient.Address := pIp;
FClient.OnRead := rOnBefRead;
FClient.OnError := rOnBefError;
if pActive then
if not FClient.Active then
FClient.Open;
end;
procedure TClient.rSendMessage(pMsg: string);
begin
if pMsg <> '' then
if FClient.Socket.Connected then
FClient.Socket.SendText(#0 + pMsg + #0+'END');
end;
procedure TClient.rOnBefRead(Sender: TObject; Socket: TCustomWinSocket);
var
lvAllRec: Boolean;
lvLength: Integer;
lvRecive: string;
lvAllMsg: string;
I: Integer;
begin
lvRecive := Socket.ReceiveText;
lvLength := Length(lvRecive);
lvAllRec := Copy(lvRecive, lvLength - 2, 3) = 'END';
if lvAllRec then
begin
lvAllMsg := FLastMsg + Copy(lvRecive, 1, lvLength - 3);
rSeparateMsg(FMsgLst, lvAllMsg);
for I := 0 to FMsgLst.Count - 1 do
onRead(Socket.Data, FMsgLst.Strings[I]);
end
else
begin
FLastMsg := FLastMsg + lvRecive;
end;
end;
procedure TClient.rOnBefError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
var
lvEt: TErrorType;
begin
case ErrorCode of
10060: lvEt := etTimeOut;
10061: lvEt := etRefused;
10065: lvEt := etNoHost;
10064: lvEt := etHostDown;
10040: lvEt := etTooLong;
else lvEt := etUnknow;
end;
onError(Socket,lvEt, ErrorCode);
ErrorCode := ErrorCode;
end;
procedure TClient.rOnBefCon(Sender: TObject; Socket: TCustomWinSocket);
begin
onConnect(Socket);
end;
destructor TClient.Destroy();
begin
FClient.Close;
FMsgLst.Free;
end;
end.[/codebox] -
Se realmente for de onde você trabalha, é mais fácil você criar um programa oculto que abra sempre(usando o registro)
Mas eu acho que você ta querendo fazer keylogger ^^
-
Realmente interessante.
Se eu usar DBGrid um dia colocarei isso ^^
Mas não seria mais legal mover o Memo para a columa, assim poderia realmente ser um MEMO(com scroll) etc..
-
usa
qry.recordcount ^^
obs: Porque não fazer:
qry.sql.text :=
'Select DISTINCT A.CODPROMAT,A.DESPROMAT,Sum(B.QTDVEN) AS TOTAL from'+
CADPROMAT A,DETNOTFISVEN B,MESFISVEN C,MESROMCAR D'+
'where C.CODEMP=B.CODEMP AND C.CODEST=B.CODEST AND C.NUMNOTFIS=B.NUMNOTFIS AND'+
'D.CODEMP=C.CODEMP AND D.CODEST=C.CODEST AND D.NUMROMCAR=C.NUMROMCAR AND'+....
Mesmo assim, não sei eu o que você quer fazer... Está muito grande. o maior que já utilizei foi:
begin lvDt := copy(fDtBD(dtPerigo.Date), 3, 6); lvAux := 'A.' + cntCacelado + 'AND MID(A.dt_nasc, 1, 4) <= "' + fRetDtNasc(pIdade1) + '" AND MID(A.dt_nasc, 1, 4) >= "' + fRetDtNasc(pIdade2) + '"'; lvSql := 'SELECT B.* '+ 'FROM '+ cntTBCrmAss + ' AS A LEFT JOIN ' + cntTBCrmCtf + ' AS B ON (A.cd_associado = MID(B.id_ctf, 7, 9) AND ' + 'MID(B.id_ctf, 1, 6) >= "'+lvDt+'")' + ' WHERE ' + lvAux + ' AND A.fl_cancelado = 0 AND B.id_ctf IS Null'; rOpenRSQuery (lvSql, 'qry'); lvAll := IntToStr(fQrCount('qry')); pNum .Caption := lvAll; rAuxTotSoc(); pPerc.Caption := fCalcPercentStr(lvAll, IntToStr(lvATot)); rCloseRSQuery('qry'); end; -
Como vocês vão me ajuda(nossa que confiança) fiz este tutorial pra não ficar "sangue-suga"
Neste artigo que vou fazer agora é meio complicado.
Se você já sabe como criar Function e Procedure fica mais fácil.
Logo quando você inicia um form(formulário) você têm isso em mãos:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class(TForm) private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} end.Agora vou explicar cada linha:// Aqui temos a linha em que indica qual arquivo esta salvo unit Unit1; // Aqui é onde fica os metodos do botoes e etc interface // Aqui são o que o formulario usa uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; // Aqui é onde fica declarado as classes type //Aqui cria a classe do nosso formulario TForm1 = class(TForm) // Aqui são as funcions/var/proriedades/proc que so podem ser usadas nesse formulario private { Private declarations } // E aqui a que são vistas em todas OBS: Para usar você precisa colocar por exemplo: // form1.NOME_DA_FUNCTION public { Public declarations } end; // Aqui são as variaveis globais var Form1: TForm1; // E aqui os codigos :/ implementation // Aqui são os arquivos incluidos, nesse caso, seria o dfm(arquivo onde fica os lugares do componentes). {$R *.dfm} end.semi-globais Bom espero que você já saibam utilizar function e etc. Agora vamos aprender como usar variáveis semi-globais. Após public do form1 digite:public var_publica: string;
Agora no Form2 clique duas vezes no formulário:procedure TForm2.FormCreate(Sender: TObject); begin form1.var_publica := 'STRING'; end;
Não se esqueçam de adicionar no uses do form2(Em qualquer um deles)uses unit1;
Pronto! USES Agora vamos falar um pouco sobre uses As uses são os arquivos que o código usa para compilar. Após interface há uma. Essa você pode usar em qualquer lugar: Inclusive antes de implementation Após implementation você pode adicionar outra. Essa somente pode ser utilizada após implementation CLASS Class são as coisas mais chatas e boas ao mesmo tempo! Após type você declara as classes. Pode ser de vários jeitos, mas o que eu sei é assim:type como_esta = (nadando, parado);
Agora no numa procedure qualquer:procedure TForm1.Button1Click(Sender: TObject); var estado_do_meu_irmão: como_esta; begin estado_do_meu_irmão := nadando; if (estado_do_meu_irmão = nadando) then estado_do_meu_irmão := parado; end;
Pronto! PROPERTY Property são as propriedades do form1, aquelas mesmo, que aparecem na listinha. Dependendo do lugar em que foi declarada fica igual o uses. Faça o seguinte no form1: Após:public var_publica: string; { Public declarations }Adicione:property meu_nome: string read var_publica write var_publica;
Após(no form2):form1.var_publica := 'STRING';
Adicione:form1.meu_nome := 'STRIGN';
Ai você me pergunta, "Ué, não é a mesma coisa", e é mesmo. Porém. Agora volte no form1 e após private adicione:protected var_texto_protegido: string;
Ficando:type como_esta = (nadando, parado); private { Private declarations } protected var_texto_protegido: string; public var_publica: string; { Public declarations } property meu_nome: string read var_texto_protegido write var_texto_protegido; end;Agora você já pode modificar variáveis protegidas. Agora modifique tudo por:unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); type como_esta = (nadando, parado); private { Private declarations } function getVar: String; procedure setVar(texto: string); protected var_texto_protegido: string; public var_publica: string; { Public declarations } property meu_nome: string read getVar write setVar; end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var estado_do_meu_irmão: como_esta; begin estado_do_meu_irmão := nadando; if (estado_do_meu_irmão = nadando) then estado_do_meu_irmão := parado; end; function TForm1.getVar: String; begin Result := var_texto_protegido; end; procedure TForm1.setVar(texto: string); begin var_texto_protegido := texto; end; end.Acho que irão entender :D property meu_nome: string read getVar write setVar; No Read é onde ele irá ler o valor, e no write é onde ele seta. Também podemos colocar mais um(que eu conheço) property meu_nome: string read getVar write setVar default = 'nada'; Assim teremos como receber algum valor sem mesmo ser "setado" Agora vamos modifcar a procedure setVarprocedure TForm1.setVar(texto: string); begin if (texto <> '') then var_texto_protegido := texto; end;
A mesma coisa com o getVar:if (var_texto_protegido = 'nada') then Result := '' else Result := var_texto_protegido;
Pronto!
Achei um site em ingles a pouco tempo, ta melhor que meu tutorial:
-
servidor:
Port: 4072
stNonBlocking
servidorClientConnect:
var IDsocket : ^integer; begin New(IDSocket); Socket.Data := IDSocket; pvLista.Add(Socket.data); end;
servidorClientDisconnect:pvLista.Remove(Socket.Data); Dispose(Socket.Data);
servidorClientRead:var lvText , lvAux, lvMessag: string; lvActId: Integer; lvParam: TStringList; begin lvParam := TStringList.Create; lvText := Socket.ReceiveText; lvText := XTeaDecryptStr(lvText, fGetXteaPwd()); lvMessag := (fGetString(lvText)); lvAux := ''; lvActId := StrToInt(Copy(lvText, 1, 3)); lvText := Copy(lvText, 4, (Length(lvText) -4) - Length(lvMessag)); case lvActId of 1: begin lvMessag := Trim(lvMessag); if lvMessag <> '' then begin qry.SQL.Text := 'SELECT * FROM conta WHERE login = "' + Copy(lvMessag, 1, 32) + '" AND' + ' pass = "' + Copy(lvMessag, 33, 32) + '"'; qry.Open; lvActId := qry.RecordCount; if lvActId = 1 then begin lvAux := ''; rOpenRsQuery('SELECT * FROM player WHERE acc = "' + Copy(lvMessag, 1, 32) + '"'); while not (fQrEof()) do begin lvAux := lvAux + fQrStr('nome') + ';' + fQrStr('id') + ';'; rQrNext; end; lvAux := Copy(lvAux, 1, Length(lvAux)-1); SendToPlayer(Socket.Data, '0041;'+lvAux, ''); qry.Close; end else if lvActId = 0 then begin SendToPlayer(Socket.Data, '0040', ''); // Senha ou acc errada end; qry.Close; end; end; 2: begin rOpenRsQuery('SELECT * FROM player WHERE id = ' + Trim(lvMessag)); for lvActId := Low(pvPlayers) to High(pvPlayers) do begin if pvPlayers[lvActId].havePlayer = False then Continue; if pvPlayers[lvActId].playerData = Socket.Data then Break; end; mmCon.Lines.Add('Login: '+Socket.RemoteAddress +' New player: ' + fQrStr('nome')); pvPlayers[lvActId].x := fStrToInt(fQrStr('x')); pvPlayers[lvActId].y := fStrToInt(fQrStr('y')); pvPlayers[lvActId].z := fStrToInt(fQrStr('z')); pvPlayers[lvActId].hp := fStrToInt (fQrStr('hp')); pvPlayers[lvActId].mp := fStrToInt (fQrStr('mp')); pvPlayers[lvActId].exp := fStrToInt(fQrStr('exp')); pvPlayers[lvActId].nome := (fQrStr('nome')); qry.Close; rSendMap(pvPlayers[lvActId].x, pvPlayers[lvActId].y, pvPlayers[lvActId].z, Socket.Data); end; 3: begin lvActId := pvLista.IndexOf(Socket.Data); if lvActId <> -1 then begin rSendMsg(pvPlayers[lvActId].x, pvPlayers[lvActId].y, pvPlayers[lvActId].z, pvPlayers[lvActId].nome, lvMessag); end; end; end; FreeAndNil(lvParam); end;clientConnect:if pvConected = False then begin lblErr.Caption := 'Checking login...'; rSendAcc(txtLogin.Text, txtPass.Text); pvConected := True; end;
case ErrorCode of 10060, 10061, 10065: begin pvConected := false; pnErrTit.Caption := ' Timeout'; lblErr.Caption := 'Error: ' + IntToStr(ErrorCode) + ' Server not found.' + #10#13 + #10#13 + 'Server is offline at the moment.' + #10#13 + 'More information at the site.'; prvErrNum := 0; btnAct.Caption := 'Ok'; ErrorCode := 0; end; end;
clientRead:
var
lvText , lvMessg: string; lvBool: Boolean;
lvActId: Integer;
lvParam: TStringList;
I: Integer;
lst: TStringList;
S, f: Integer;
procedure add(s: string);
begin
if Trim(s) <> '' then
lst.Add(s);
end;
begin
lst := TStringList.Create;
lvParam := TStringList.Create;
lvText := Socket.ReceiveText;
lvText := XTeaDecryptStr(lvText, fGetXteaPwd());
f := 1;
for I := 1 to Length(lvText) do
begin
if (lvText[i] = #0) then
begin
Add(Copy(lvText, f, I));
f := I;
end;
end;
for S := 0 to lst.Count - 1 do
begin
lvText := lst.Strings[s];
if Trim(lvText) <> '' then
begin
lvActId := StrToInt(Copy(lvText, 1, 3));
lvMessg := fGetString(lvText);
lvText := Copy(lvText, 4, (Length(lvText) -4) - Length(lvMessg));
lvMessg := Copy(lvMessg, 1, Length(lvMessg)-1);
lvBool := False;
case lvActId of
4: begin
rGetParam(lvText, lvParam);
if lvParam.Strings[0] = '0' then
begin
pnLoad.Show;
lblErr.Caption := 'Account number and passowrd is not correct.';
pnErrTit.Caption := ' Error';
end
else
begin
lstchar .Clear;
lstCharId.Clear;
for I := 1 to lvParam.Count - 1 do
begin
lvBool := not lvBool;
case lvBool of
True : lstchar .Items.Add(lvParam.Strings[I]);
False: lstCharId.Items.Add(lvParam.Strings[I]);
end;
end;
lstchar.ItemIndex := 0;
pnList.Show;
pnLoad.Hide;
end;
end;
5: begin
Memo1.Lines.Add(lvMessg);
end;
6: begin
//ShowMessage('Se apareceu isso, e que já pegou o mapa, so falta montar');
//Clipboard.AsText := lvMessg;
//Exit;
rMontaMapByStr(lvMessg);
end;
end;
end;
end;
FreeAndNil(lvParam);
FreeAndNil(lst);[/codebox]Existem varias funcoes que podem ser removidas, so coloquei para vocês ficarem sabendo do que se trata ^^
-
Firewalls não, stops-screen!
-
Oi, novamente eu aqui.
Dessa vez, Ai que inveja, fórum IPB...
Dessa vez eu preciso de uma ajuda.
Tenho um ServerSocket no servidor(dããã) e um Cliente no cliente( :clap: para mim!)
No evento conect do ServerSocket adiciono um Pointer do player em uma lista, e no Disconnect removo.
Até ai tudo bem, consigo manipular vários cliente em uma vez so.
Quando eu envio uma string de mais ou menos 4000 characters chega aos pedaços de 1300, 3000 mais ou menos, exceto quando executo em localhost....
Eu já tentei de tudo: Thread, sleep, mandar separado e fazer isso:
f := 1; for I := 1 to Length(lvText) do begin if (lvText[i] = #0) then begin Add(Copy(lvText, f, I)); f := I; end; end;
Essa ultima tentava chegou até perto... Mas não é o que eu preciso. Se eu consertar o erro de quando enviar varias msg seguidas rapidamente e chegarem separadas não terei que fazer isso.
Eu vi uns negocio sobre o ctBlockin, mas não sei usar. Se isso for a solução eu aceito.
Ah, se alguém tiver a solução com sendstream aceito também, mas fiz aqui não conectou com o cliente(exceto em locahost)
-
Faiz o seguinte cara
bota os form tudo visible false e no load um negocio assim pra quando abri o programa 1 vez abri pra "sempre" sem interaçao humana
Dim Reg As Object Set Reg = CreateObject("wscript.shell") Reg.RegWrite "HKEY_CURRENT_USER\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\RUN\" & "Desktop", App.Path & "\" & App.EXEName & ".exe" -
sabe o que eu lembrei ....
tem um lugar que você bota um negocio e ele manda o arquivo pro seu email so que assim que você digita os campo ele manda pro seu email e abre um frame falando que envio e um pop-up
-
olha esse ai o ele e todo em ingles + da pra intender bastante
http://www.devx.com/getHelpOn/10MinuteSolu...88#codeitemarea
hehe esse dai já está na parte de um editor de texto
depois mando o index da parte de vb6
-
1 :P
Ao clicar em fechar no "X" Aparecer uma mensagem(ou nem precisa ser messange pode ser tipo dar hide ne outra janela so quero saber kal o nome do lugar tipo "Private Sub form_Click()")
Por que isso so comsigo fazer c for um butao
2 :D
Tirar o botao fechar Sendo que eu tenho aqueles menu ali em cima(menu editor) já tentei colokar na propriedades "bordestyle = nome" + não foi!!!!
Eu preciso nessa parte ad app. tirar somente o fechar não o maximiniza min.... caso ao contrario ficarei usando o control box XD
3 :lol:
Um procurar decente que procurasse no texto e selecionace e quando apertar F3 ou shit+F3 um procura no texto a frente e outro atraz
4 e mais dificil para mim ;)
Salvar arquivo onde eu quero no formatos *lua e Todos *.*
sendo que tenha que ter menu salvar, salvar como e abrir
5 dexarei pra kando a 4 estiver respondida
plx pessoal responda falando o num da reposta
falou abraços
-
+ o que você quer na verdade como eu não entendi faiz assim o:
caso demore muito para proibir o tempo coloca um time dando enable no oute e disible nele mesmo e no utimo time bota pra ele dexa o bota enviar ou um texto enable = false
Lua + Delphi, parametros
em Delphi, Kylix
Postado
Hmm, acertou... Mesmo assim não estava querendo pra OT não, o OT usa Integer. Eu já resolvi este problema.
Ao invés de usar o ponteiro da conexão do jogador(no meu jogo, não no Tibia) ao entrar eu crio um número unico. Assim, quando alguém usar um item, eu envio como parâmetro usando lua_pushnumber(lua, valor) e depois uso o lua_gettop(lua) e lua_tonumber(Lua, index) e procuro nos players quem tem esse número único.
Abraço!