Criar um EXE que seja executado apenas através de outro EXE criado por mim
Inclua na seção uses: Windows
{ Antes da linha "Application.Initialize;" de Prog1.dpr (programa a ser chamado), coloque o código abaixo:}
if ParamStr(1) <> 'MinhaSenha' then begin
{ Para usar ShowMessage, coloque Dialogs no uses }
ShowMessage('Execute este programa através de Prog2.EXE');
Halt; { Finaliza }
end;
{ No Form1 de Prog2 (programa chamador) coloque um botão e escreva o OnClick deste botão como abaixo:}
procedure TForm1.Button1Click(Sender: TObject);
var
Erro: Word;
begin
Erro := WinExec('Pro2.exe MinhaSenha', SW_SHOW);
if Erro <= 31 then { Se ocorreu erro... }
ShowMessage('Erro ao executar o programa.');
end;
Observações
Aqui o parâmetro passado foi 'MinhaSenha'. Você deverá trocar 'MinhaSenha' por algo que apenas você saiba (uma senha). Caso uma pessoa conheça esta senha, será possível chamar este programa passando-a como parâmetro. Neste caso sua "trava" estará violada.
Multiplas Seleções em DBGrid
var contador: Integer;
begin
With Dbgrid1 do
Begin
for contador:= 0 to Pred(SelectedRows.Count) do
Begin
{posiciona nos registros selecionados do DBGrid
Dataset.Bookmark:= SelectedRows[contador];
end;
end;
Obter o tipo de um drive (removível, fixo, CD-ROM, unidade de rede, etc)
Inclua na seção uses: Windows, Dialogs
{ - Coloque um edit (Edit1) e um botão no form;
- Altere o OnClick do botão conforme abaixo: }
procedure TForm1.Button1Click(Sender: TObject);
var
S: string;
Tipo: byte;
begin
Tipo := GetDriveType(PChar(Edit1.Text[1] + ':\'));
case Tipo of
0: S := 'Tipo indeterminado';
1: S := 'Drive não existe';
DRIVE_REMOVABLE: S := 'Disco removível';
DRIVE_FIXED: S := 'Disco Fixo';
DRIVE_REMOTE: S := 'Unidade de rede';
DRIVE_CDROM: S := 'CD-ROM';
DRIVE_RAMDISK: S := 'RAM Disk';
else
S := 'Erro';
end;
ShowMessage(S);
end;
{ Para pegar o tipo da unidade atual troque...}
Tipo := GetDriveType(PChar(Edit1.Text[1] + ':\'));
{ por }
Tipo := GetDriveType(nil);
Observações
Para testar digite a letra do drive no Edit1 e clique no botão. A unit Dialogs foi colocada no uses apenas por causa da procedure ShowMessage. Para exibir todas as unidades existentes e seus respectivos tipos, use a função tbGetDrives (da pergunta 64) em conjunto com este exemplo.
Saber quais as unidades de disco
(drives) estão presentes
Inclua na seção uses: Windows
{ A função abaixo retorna uma string contendo as letras de unidades de discos presentes. }
function tbGetDrives: string;
var
Drives: DWord;
I: byte;
begin
Result := '';
Drives := GetLogicalDrives;
if Drives <> 0 then
for I := 65 to 90 do
if ((Drives shl (31 - (I - 65))) shr 31) = 1 then
Result := Result + Char(I);
end;
{ Para saber se uma determinada unidade está presente,
basta fazer algo como: }
if Pos('A', tbGetDrives) > 0 then
ShowMessage('Unidade A: presente.')
else
ShowMessage('Unidade A: ausente.');
Observações
A string retornada pela função tbGetDrives está sempre em letras maiúsculas.
Imprimir texto justificado com formatação na impressora Epson
LX-300
{ A impressora Epson LX-300 dispõe de um comando que justifica o texto. Este recurso é interessante, pois com ele podemos continuar a enviar os comandos de formatação de caracteres como condensado, negrito, italico, expandido, etc.
Para o exemplo abaixo:
- Coloque um botão no form;
- Altere o evento OnClick deste botão como abaixo: }
procedure TForm1.Button1Click(Sender: TObject);
const
cJustif = #27#97#51;
cEject = #12;
{ Tamanho da fonte }
c10cpi = #18;
c12cpi = #27#77;
c17cpi = #15;
cIExpandido = #14;
cFExpandido = #20;
{ Formatação da fonte }
cINegrito = #27#71;
cFNegrito = #27#72;
cIItalico = #27#52;
cFItalico = #27#53;
var
Texto: string;
F: TextFile;
begin
Texto := c10cpi +
'Este e um teste para impressora Epson LX 300. ' +
'O objetivo e imprimir texto justificado sem deixar ' +
'de usar formatacao, tais como: ' +
cINegrito + 'Negrito, ' + cFNegrito +
cIItalico + 'Italico, ' + cFItalico +
c17cpi + 'Condensado (17cpi), ' + c10cpi +
c12cpi + '12 cpi, ' + c10cpi +
cIExpandido + 'Expandido.' + cFExpandido +
' Este e apenas um exemplo, mas voce podera adapta-lo ' +
'a sua realidade conforme a necessidade.';
AssignFile(F, 'LPT1');
Rewrite(F);
try
WriteLn(F, cJustif, Texto);
WriteLn(F, cEject);
finally
CloseFile(F);
end;
end;
Observações
Este recurso de justificação da Epson LX-300 pode ser usado em qualquer linguagem de programação.
Executar um arquivo com extensão
*.LNK
uses ShellApi;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(0,nil,'C:\WINDOWS\START MENU\DELPHI\Delphi3.lnk' ,nil, nil, SW_SHOWNORMAL);
end;
Colocar
Hint's de várias linhas
{ - Coloque um TButton no Form;
- Altere o evento OnCreate do Form como abaixo: }
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Hint := 'Linha 1 da dica' + #13 +
'Linha 2 da dica' + #13 +
'Linha 3 da dica';
Button1.ShowHint := true;
end;
Para que servem
OnGetEditMask, OnGetEditText e OnSetEditText do TStringGrid
O evento OnGetEditMask ocorre quando entramos no modo de edição. Neste momento podemos verificar em qual linha/coluna se encontra o cursor e então, se quiser, poderá especificar uma máscara de edição. Exemplo:
procedure TForm1.StringGrid1GetEditMask(Sender: TObject; ACol,
ARow: Integer; var Value: String);
begin
if (ARow = 1) and (ACol = 1) then
Value := '(999) 999-9999;1;_'; // Telefone
end;
O evento OnGetEditText ocorre também quando entramos no modo de edição. Neste momento podemos manipularmos o texto da célula atual (linha/coluna) e então podemos simular algo tal como uma tabela onde opções podem ser digitadas através de números. Exemplo:
procedure TForm1.StringGrid1GetEditText(Sender: TObject; ACol,
ARow: Integer; var Value: String);
begin
if (ARow = 1) and (ACol = 2) then begin
if StringGrid1.Cells[ACol, ARow] = 'Ótimo' then
Value := '1'
else if StringGrid1.Cells[ACol, ARow] = 'Regular' then
Value := '2'
else if StringGrid1.Cells[ACol, ARow] = 'Ruim' then
Value := '3';
end;
end;
O evento evento OnSetEditText ocorre quando saímos do modo de edição. Neste momento podemos manipular a entrada e trocar por um texto equivalente. Normalmente usamos este evento em conjunto com o evento OnGetEditText. Exemplo:
procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol,
ARow: Integer; const Value: String);
begin
if (ARow = 1) and (ACol = 2) then begin
if Value = '1' then
StringGrid1.Cells[ACol, ARow] := 'Ótimo'
else if Value = '2' then
StringGrid1.Cells[ACol, ARow] := 'Regular'
else if Value = '3' then
StringGrid1.Cells[ACol, ARow] := 'Ruim'
end;
end;
Observações
Para testar o exemplo anterior crie um novo projeto e coloque no Form1 um TStringGrid. Mude os três eventos mencionados conforme os exemplos. Execute e experimente digitar nas céluas 1 e 2 da primeira linha (na parte não fixada, é claro!).
Mostrando progresso de uma SQL
Algumas pessoas estavam interessadas em saber como apresentar o progresso
de um TQuery enquanta ele esta sendo aberto (ou executada, no caso de um
INSERT / UPDATE / DELETE).
A tecnica que vou demostrar nao apenas serve para o proposito procurado,
mas tambem serve para mostrar o progresso de diversas outras atividades que
o BDE executa, como:
* Criacao de tabelas
* Criacao de indices para tabelas
* Reestruturacao de tabelas
* Execucao de queries (ja comentado)
* alguma outra coisa que no momento nao me ocorre... :))
Importante:
1) No meu exemplo, estou usando o Delphi 3.02. Caso seu Delphi seja de
uma versao menor, vc devera ter um trabalho extra para repor a classe
TBDECallback. Acredito que seja possivel fazer uma rotina que funcione em
Delphi 1, mas que com certeza dara um certo trabalhinho, ah, isso dara...
:-/
2) Ate agora so usei esse codigo com tabelas Paradox, mas realmente
acredito que ele venha a funcionar com base de dados Interbase, Oracle,
etc...
3) Nao sei se com o uso do Opus, Apollo ou qualquer outro substituto do
BDE a tecnica ira funcionar, uma vez que nao se estaria trabalhando com o
BDE original. Talvez alguem da lista possa dar essa informacao.
Teoria
=====
Segundo o help do Delphi, "o TBDECallback eh um wrapper para uma funcao
de callback do BDE. Com ele eh possivel instruir o BDE para que o mesmo
execute algumas tarefas em resposta a eventos que ocorram durante uma
chamada de uma funcao do BDE. " - Fim do plagio do arquivo de help.
O tipo de callback depende de um parametro CBType que eh fornecido no
momento da criacao do TBDECallback. E, entre os diversos valores que o
CBType pode apresentar, existe um que muito nos interessa; o cbGENPROGRESS.
:))
Assim, vc deveria criar uma funcao de callback do tipo cbGENPROGRESS
chamada AtualizaGauge e indicar que a mesma eh que devera ser executada
"entre cada respiracao" do BDE. Na rotina AtualizaGauge, o BDE iria te
informar o percentual de progresso da tarefa .
O que voce faria nessa rotina ? Simples... atualizar o Gauge / ProgressBar.
Tudo muito bonito, tudo muito comovente, mas agora vamos para o lado
pratico...
Pratica
======
Para que o BDE possa informar o progresso da tarefa, ele precisa obter
essa informacao da base de dados que esta sendo utilizada. Acontece que,
por razoes diferentes, nem sempre ele eh capaz de saber o PERCENTUAL da
tarefa. Numa copia de registros de uma tabela para outra, ele pode saber
que ja foram copiados 270 registros, mas nao saber que esse esforco
representa 36 % de todos os registros que serao copiados.
Assim sendo, na funcao de callback que sera criada, receberemos um
parametro do tipo pCBPROGRESSDesc, que por sua vez eh um ponteiro para uma
estrutura que contem duas informacoes:
iPercentDone => percentual do servico realizado
szMsg => texto descrevendo o progresso do servico.
Como usar esses parametros ? Simples: sempre que o iPercentDone for
negativo, voce devera considerar o texto descrito no campo szMsg. Se for
igual ou maior que zero, entao vc devera considerar o valor do proprio
iPercentDone.
Uma boa noticia para quem se preocupa com as mensagens que aparecem em
ingles, quando se quer na verdade mostra-las em portugues: a mensagem
fornecida por szMsg devera sempre aparecer no formato <mensagem><:><valor>
.....
Exemplo:
Records copied: 170
Assim, voce pode procurar pelos dois pontos ":" e pegar o valor que vem a
seguir para montar sua propria informacao em portugues.
Pessoalmente, ate agora nunca obtive um iPercentDone positivo. Li no
newsgroup da Borland que poucas bases de dados eram capazes de informar o
real percentual para o BDE. Se nao me engano, o Sybase era um deles... NAO
ESTOU CERTO DISSO.
Vamos para um exemplo pratico ? Crie um projeto novo, e coloque um:
TQuery, TButton, TProgressBar e TLabel.
Sua query deve ser montada para abrir uma tabela razoavelmente grande, de
modo que a operacao de abertura demore um pouco.
Agora vamos aos codigos:
1) Acrescente a unit BDE no seu USES da unit.
2) Acrescente algumas declaracoes na declaracao do seu Form:
==============================
type
TForm1 = class(TForm)
... (bla bla bla)
private
{ Private declarations }
FCBPROGRESSDesc: pCBPROGRESSDesc;
FProgressCallback: TBDECallback;
function GetDataCallback(CBInfo: Pointer): CBRType;
public
{ Public declarations }
end;
==============================
No evento OnCreate do seu Form:
==============================
procedure TForm1.FormCreate(Sender: TObject);
begin
FCBPROGRESSDesc := AllocMem(SizeOf(CBPROGRESSDesc));
FProgressCallback := TBDECallback.Create(Self, Query1.Handle,
cbGENPROGRESS, FCBPROGRESSDesc, SizeOf(CBPROGRESSDesc),
GetDataCallback, True);
end;
==============================
Percebam que no segundo parametro do Create do callback, eu coloquei
Query1.Handle.
Caso voce queira usar isso numa TTable, coloque Table1.Handle.
E se quiser que essa funcao de callback seja chamada para todos os
"progressos" de qualquer componente DataSet, voce deixa esse parametro como
NIL.
No evento OnDestroy do Form:
==============================
procedure TForm1.FormDestroy(Sender: TObject);
begin
FProgressCallback.Free;
FreeMem(FCBPROGRESSDesc, SizeOf(CBPROGRESSDesc));
end;
==============================
E agora, a tao falada funcao de callback:
==============================
function TForm1.GetDataCallback(CBInfo: Pointer): CBRType;
begin
Result := cbrCONTINUE;
with pCBPROGRESSDesc(CBInfo)^ do
begin
if iPercentDone < 0 then
begin
Label1.Caption := szMsg;
Label1.Refresh;
ProgressBar1.StepIt; {Apenas para ficar rodando o gauge}
end
else
ProgressBar1.Position := iPercentDone;
end;
end;
==============================
Agora eh so executar a query no clicar do botao e curtir o visual... :))
IMPORTANTE !!!!!!
Caso voce receba uma mensagem de erro informando que nao foi possivel
inicializar o BDE (o que provavelmente acontecera, pois voce esta criando
uma funcao de callback do BDE, quando ate entao nenhuma tabela havia sido
aberta), va no DPR do seu projeto (Menu View -> Project Source) e faca o
seguinte:
1) Acrescente a unit BDE no uses do projeto.
2) Acrescente a instrucao
DbiInit(nil);
apos a instrucao Application.Initialize;
Isso deve resolver o problema.
Bom, nao vou me alongar mais, porque senao essa mensagem vai ficar maior do
que ja esta...
Espero que tenha contribuido para a solucao desse problema de mostar
progresso de uma query. Qualquer duvida mandem mensagem.
Validar
a entrada em uma caixa de texto
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
begin
If not(key in['0'..'9',#8]) then
begin
beep;{somente delphi 2.0 ou 3.0} key:=#0;
end;
end
Chamar
a caixa de dialogo Localizar arquivos do Windows Explorer
procedure TForm1.Button1Click(Sender: TObject);
begin
with TDDEClientConv.Create(Self) do begin
ConnectMode := ddeManual;
ServiceApplication := 'explorer.exe';
SetLink( 'Folders', 'AppProperties');
OpenLink;
ExecuteMacro('[FindFolder(, C:\Windows)]', False);
CloseLink;
Free;
end;
end
Pegar o número serial de um CD de Audio
The cd may or may not have a serial number and/or Universal Product
Code embedded in the cd. The MCI Windows extension does provide this
functionality through the MCI_INFO_MEDIA_IDENTITY command. This
command will return a unique ID string consisting of 16 hexadecimal
digits.
Example:
uses MMSystem, MPlayer;
procedure TForm1.Button1Click(Sender: TObject);
var
mp : TMediaPlayer;
msp : TMCI_INFO_PARMS;
MediaString : array[0..255] of char;
ret : longint;
begin
mp := TMediaPlayer.Create(nil);
mp.Visible := false;
mp.Parent := Application.MainForm;
mp.Shareable := true;
mp.DeviceType := dtCDAudio;
mp.FileName := 'D:';
mp.Open;
Application.ProcessMessages;
FillChar(MediaString, sizeof(MediaString), #0);
FillChar(msp, sizeof(msp), #0);
msp.lpstrReturn := @MediaString;
msp.dwRetSize := 255;
ret := mciSendCommand(Mp.DeviceId,
MCI_INFO,
MCI_INFO_MEDIA_IDENTITY,
longint(@msp));
if Ret <> 0 then begin
MciGetErrorString(ret, @MediaString, sizeof(MediaString));
Memo1.Lines.Add(StrPas(MediaString));
end else
Memo1.Lines.Add(StrPas(MediaString));
mp.Close;
Application.ProcessMessages;
mp.free;
end;
end.
Mapear uma unidade de rede via código
var
err : DWord;
PServer, PSenha, PLetra : PChar;
Begin
PServer := Server;
PLetra := Alias;
PSenha := senha;
ERR := WNetAddConnection ( PServer , PSenha , PLetra );
case ERR of
ERROR_ACCESS_DENIED : result := 'Acesso negado.';
ERROR_ALREADY_ASSIGNED : result := 'A letra do drive especificada já está conectada.';
ERROR_BAD_DEV_TYPE : result := 'O tipo de dispositivo e o tipo de recurso não são compatíveis.';
ERROR_BAD_DEVICE : result := 'Letra inválida.';
ERROR_BAD_NET_NAME : result := 'Nome do servidor não é válido ou não pode ser localizado.';
ERROR_BAD_PROFILE : result := 'Formato incorreto de parâmetros.';
ERROR_CANNOT_OPEN_PROFILE : result := 'Conexão permanente não disponível.';
ERROR_DEVICE_ALREADY_REMEMBERED : result := 'Uma entrada para o dispositivo especificado já está no perfil do usuário.';
ERROR_EXTENDED_ERROR : result := 'Erro de rede.';
ERROR_INVALID_PASSWORD : result := 'Senha especificada inválida.';
ERROR_NO_NET_OR_BAD_PATH : result := 'A operação não foi concluída porque a rede não foi inicializada ou caminho é inválido.';
ERROR_NO_NETWORK : result := 'A rede não está presente.';
else
result := 'A Conexão '+ server+ ' na unidade '+ Alias+' Foi efetuada corretamente';
end;
Mapear uma unidade de rede via código
var
err : DWord;
PServer, PSenha, PLetra : PChar;
Begin
PServer := Server;
PLetra := Alias;
PSenha := senha;
ERR := WNetAddConnection ( PServer , PSenha , PLetra );
case ERR of
ERROR_ACCESS_DENIED : result := 'Acesso negado.';
ERROR_ALREADY_ASSIGNED : result := 'A letra do drive especificada já está conectada.';
ERROR_BAD_DEV_TYPE : result := 'O tipo de dispositivo e o tipo de recurso não são compatíveis.';
ERROR_BAD_DEVICE : result := 'Letra inválida.';
ERROR_BAD_NET_NAME : result := 'Nome do servidor não é válido ou não pode ser localizado.';
ERROR_BAD_PROFILE : result := 'Formato incorreto de parâmetros.';
ERROR_CANNOT_OPEN_PROFILE : result := 'Conexão permanente não disponível.';
ERROR_DEVICE_ALREADY_REMEMBERED : result := 'Uma entrada para o dispositivo especificado já está no perfil do usuário.';
ERROR_EXTENDED_ERROR : result := 'Erro de rede.';
ERROR_INVALID_PASSWORD : result := 'Senha especificada inválida.';
ERROR_NO_NET_OR_BAD_PATH : result := 'A operação não foi concluída porque a rede não foi inicializada ou caminho é inválido.';
ERROR_NO_NETWORK : result := 'A rede não está presente.';
else
result := 'A Conexão '+ server+ ' na unidade '+ Alias+' Foi efetuada corretamente';
end;
{Procedure que mantem o form no tamanho normal independente da resolução de vídeo
deve ser colocada na unit do form que se deseja fazer o ajuste}
Const
nTamOriginal = 640; // Será o 100% da escala
Var
nEscala : Double; // Vai me dar o percentual de Transformação escalar
nPorcento : Integer; // Vai me dar em percentual inteiro o valor
begin
With Formulario do
begin
if nTamOriginal <> Screen.Width then
begin
nEscala := ((Screen.Width-nTamOriginal)/nTamOriginal);
nPorcento := Round((nEscala*100) + 100);
Self.Width := Round(Self.Width * (nEscala+1));
Self.Height := Round(Self.Height * (nEscala+1));
Self.ScaleBy(nPorcento,100);
end;
end;
end;
Function PrimeiroDiaUtil(Data : TDateTime) : TDateTime;
//
// Retorna data do primeiro dia Util do mes, de uma data informada
//
var Ano, Mes, Dia : word;
DiaDaSemana : Integer;
begin
DecodeDate (Data, Ano, Mes, Dia);
Dia := 1;
DiaDaSemana := DayOfWeek(Data);
if DiaDaSemana = 1 Then
begin
Dia := 2;
end
else if DiaDaSemana = 7 Then
begin
Dia := 3;
end;
Result := EncodeDate (Ano, Mes, Dia);
end;