GetWindows

01/02/2013

3

Olá Pessoal!
Achei essa Função na Net:
Var
Buffer : Array[0..144] of Char;
Begin
GetWindowsDirectory(Buffer,144);
Result := StrPas(Buffer);

Estou usando ela assim: ExtractWindowsDir+''\Lib32.dll'', 12);

Está funcionando blz, o problema é que nos computadores que tem windows 7, não é permitido gravar arquivo na pasta windows
sem executar o programa como administrador. Resumindo, preciso criar uma função que faça a mesma coisa, mas permita eu escolher o diretório que vou criar e editar essa dll.

ps. Sou iniciante em Delphi.
Responder

Posts

01/02/2013

Bruno Leandro

Olá Mota você copia essa dll toda vez que inicia o seu programa, ou você copia na instalação e utiliza ela, não poderia utilizar no temp por exemplo ?
Responder

01/02/2013

Rafael Mota

Oi Bruno Leandro!
Eu uso essa Dll para verificar quantos dias falta pra expirar a licença de uso do sistema. Sempre que o
sistema é inicializado ele altera essa Dll. Como eu sou iniciante e peguei essa função na internet não sei bem como alterá-la.

var
sRestante :String;
IniCfg :TIniFile;
begin
try
if FileExists(ExtractWindowsDir+'\lib32.dll') then
begin
try
EnDecryptFile(ExtractWindowsDir+'\Lib32.dll', ExtractWindowsDir+'\Lib32.dll', 12);
IniCfg:= TIniFile.Create('Lib32.dll');
sRestante:= IniCfg.ReadString('Libera','Restante','');
finally
IniCfg.Free;
IniCfg:= Nil;
EnDecryptFile(ExtractWindowsDir+'\Lib32.dll', ExtractWindowsDir+'\Lib32.dll', 12);
end;
Responder

05/02/2013

Bruno Leandro

Ola Mota, a dll esta sendo utilizada na pasta do windows para dificultar a localização, mas como ela esta criptografada você pode utiliza-la na pasta da aplicação mesmo. para pegar o diretorio da sua aplicação voce pode usar

ExtractFilePath(Application.ExeName)
Responder

05/02/2013

Rafael Mota

Bruno Obrigado por está me ajudando, mas veja bem!
A Função abaixo:
Function ExtractWindowsDir : String;
Var
Buffer : Array[0..144] of Char;
Begin
GetWindowsDirectory(Buffer,144);
Result := StrPas(Buffer);
End;

Está sendo usada assim==> EnDecryptFile(ExtractWindowsDir+'\Lib32.dll', ExtractWindowsDir+'\Lib32.dll', 12);

Se eu colocar como está abaixo não funciona, pq ExtractFilePath não consegue ler a lib32.dll EnDecryptFile(ExtractFilePath(Application.ExeName)+'\Lib32.dll',ExtractFilePath(Application.ExeName)+'\Lib32.dll', 12);
Responder
Bruno Obrigado por está me ajudando, mas veja bem!
A Função abaixo:
Function ExtractWindowsDir : String;
Var
Buffer : Array[0..144] of Char;
Begin
GetWindowsDirectory(Buffer,144);
Result := StrPas(Buffer);
End;

Está sendo usada assim==> EnDecryptFile(ExtractWindowsDir+'\Lib32.dll', ExtractWindowsDir+'\Lib32.dll', 12);

Se eu colocar como está abaixo não funciona, pq ExtractFilePath não consegue ler a lib32.dll EnDecryptFile(ExtractFilePath(Application.ExeName)+'\Lib32.dll',ExtractFilePath(Application.ExeName)+'\Lib32.dll', 12);



Você deve alterar em todos os lugares do sistema onde tem "ExtractWindowsDir" colocar "ExtractFilePath(Application.ExeName)"
e a DLL "Lib32.dll" deve estar na mesma pasta que esta o EXE do seu sistema!
Responder

24/02/2013

Alisson Santos

Conseguiu sanar a duvida amigo.
Responder

26/02/2013

Rafael Mota

Ainda não! Você tem alguma dica?
Vlw...
Responder
Ainda não! Você tem alguma dica?
Vlw...



Você seguiu esses passos?


Você deve alterar em todos os lugares do sistema onde tem "ExtractWindowsDir" colocar "ExtractFilePath(Application.ExeName)"
e a DLL "Lib32.dll" deve estar na mesma pasta que esta o EXE do seu sistema!
Responder

26/02/2013

Rafael Mota

Já fiz sim colegas, não funciona!
Me digam como uma função que está assim:
begin
Var
Buffer : Array[0..144] of Char;
Begin
GetWindowsDirectory(Buffer,144);
Result := StrPas(Buffer);
End;

Vai Funcionar assim:
begin
Var
Buffer : Array[0..144] of Char;
Begin
ExtractFilePath(Application.ExeName(Buffer,144));
Result := StrPas(Buffer);

Se eu substituir tudo por ExtractFilePath(Application.ExeName) a dll vai ser criada no local onde se encontra o executável
mas não consigo ler a dll.
Responder
Já fiz sim colegas, não funciona!
Me digam como uma função que está assim:
begin
Var
Buffer : Array[0..144] of Char;
Begin
GetWindowsDirectory(Buffer,144);
Result := StrPas(Buffer);
End;

Vai Funcionar assim:
begin
Var
Buffer : Array[0..144] of Char;
Begin
ExtractFilePath(Application.ExeName(Buffer,144));
Result := StrPas(Buffer);

Se eu substituir tudo por ExtractFilePath(Application.ExeName) a dll vai ser criada no local onde se encontra o executável
mas não consigo ler a dll.



apenas uma correção:
ao invés de

ExtractFilePath(Application.ExeName(Buffer,144));

coloque:
ExtractFilePath(Application.ExeName);


e quando você diz:
não funciona!

da algum erro?

poderia colocar o código completo das unit's envolvidas?
assim pode reproduzir o ambiente em nossas maquinas e fazer as devidas correções nos códigos para que funcione!
Responder

26/02/2013

Rafael Mota

Posso sim, com muito Prazer! (São grandes rsrs)
Tenho essa:
unit ntGetLibera;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IniFiles, uLiber, ntLibera;

var
bAntecipar:Boolean;

procedure EnDecryptFile(INFName, OutFName : String; Chave : Word);
Function GetLibera:Boolean;
Function ExtractWindowsDir : String;
function DiasRestante:Integer;
function AnteciparLiberacao(iDias:Integer; sMsgAnt:String):Boolean;
procedure ChamaLiberacao;

implementation

uses UformMensagens;

procedure ChamaLiberacao;
begin
Application.CreateForm(TfrmLibera, frmLibera);
frmLibera.ShowModal;
frmLibera:= Nil;
end;

function DiasRestante:Integer;
var
sRestante :String;
IniCfg :TIniFile;
begin
try
if FileExists(ExtractWindowsDir+'\Help.dll') then
begin
try
EnDecryptFile(ExtractWindowsDir+'\Help.dll', ExtractWindowsDir+'\Help.dll', 12);
IniCfg:= TIniFile.Create('Help.dll');
sRestante:= IniCfg.ReadString('Libera','Restante','');
finally
IniCfg.Free;
IniCfg:= Nil;
EnDecryptFile(ExtractWindowsDir+'\Help.dll', ExtractWindowsDir+'\Help.dll', 12);
end;

if StrToInt(sRestante) > 0 then
bAntecipar:= True
else
bAntecipar:= False;

Result:= StrToInt(sRestante);
end else
begin
bAntecipar:= False;
Result:= 0;
end;
except
bAntecipar:= False;
Result:= 0;
end;
end;

function AnteciparLiberacao(iDias:Integer; sMsgAnt:String):Boolean;
var
sMsg:String;
begin
if (DiasRestante >0) and (DiasRestante <= iDias) then
begin
if FormMensagens.Mensagem('RESTA(M) '+IntToStr(DiasRestante) +' DIA(S) PARA SUA LICENÇA EXPIRAR, DESEJA RENOVÁ-LA AGORA?' ,'I',[MbNao,MbSim]) then
begin
ChamaLiberacao;
end;
end;
end;

Function GetLibera:Boolean;
var
sData :String;
sRestante :String;
sHd :String;
IniCfg :TIniFile;
begin
try
if not FileExists(ExtractWindowsDir+'\Help.dll') then
begin
try
IniCfg:= TIniFile.Create('Help.dll');
iniCfg.WriteString('Libera','Atual',DateToStr(Date));
iniCfg.WriteString('Libera','Restante','0');
iniCfg.WriteString('Libera','Serial',Copy(SerialNum,2,2));
finally
IniCfg.Free;
EnDecryptFile(ExtractWindowsDir+'\Help.dll', ExtractWindowsDir+'\Help.dll', 12);
end;
end;

try
EnDecryptFile(ExtractWindowsDir+'\Help.dll', ExtractWindowsDir+'\Help.dll', 12);
IniCfg:= TIniFile.Create('Help.dll');

sData:= IniCfg.ReadString('Libera','Atual','');
sRestante:= IniCfg.ReadString('Libera','Restante','');
sHd:= IniCfg.ReadString('Libera','Serial','');

if StrToDate(sData) <> Date then
begin
sData:= DateToStr(Date);

if StrToInt(sRestante) > 0 then
sRestante:= FloatToStr(StrToFloat(sRestante) - 1);
end;

if (StrToInt(sRestante) <= 0) or (sHd <> Copy(SerialNum,2,2)) then
Result:= True
else
Result:= False;

iniCfg.WriteString('Libera','Atual',sData);
iniCfg.WriteString('Libera','Restante',sRestante);
finally
IniCfg.Free;
EnDecryptFile(ExtractWindowsDir+'\Help.dll', ExtractWindowsDir+'\Help.dll', 12);
end;
except
if FileExists(ExtractWindowsDir+'\Help.dll') then
DeleteFile(ExtractWindowsDir+'\Help.dll');
Result:= True;
end;

end;

procedure EnDecryptFile(INFName, OutFName : String; Chave : Word);
var
InMS, OutMS : TMemoryStream;
I : Integer;
C : byte;
begin
InMS := TMemoryStream.Create;
OutMS := TMemoryStream.Create;
try
InMS.LoadFromFile(INFName);
InMS.Position := 0;
for I := 0 to InMS.Size - 1 do
begin
InMS.Read(C, 1);
C := (C xor not(ord(chave shr I)));
OutMS.Write(C,1);
end;
OutMS.SaveToFile(OutFName);
finally

InMS.Free;
OutMS.Free;
end;
end;

Function ExtractWindowsDir : String;
Var
Buffer : Array[0..144] of Char;
Begin
GetWindowsDirectory(Buffer,144);
Result := StrPas(Buffer);
End;

end.

E essa:

unit uLiber;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IniFiles;

Function WindowsDir : String;
Function SerialNum : String;
Function LimpaSerial(Dados:String):String;
Function Crypt(Action, Src: String): String;
Function Replica( pString:String; xWidth:Integer ):String;

implementation

//--- Retorna a letra onde o windows está instalado
//-------------------------------------------------
Function WindowsDir : String;
Var
Buffer : Array[0..144] of Char;
Begin
GetWindowsDirectory(Buffer,144);
Result := Copy(StrPas(Buffer),1,1);
End;

//--- Retorna o número serial da unidade onde o windows
//--- se encontra -------------------------------------
Function SerialNum :String;
Var
Serial:DWord;
DirLen,Flags: DWord;
DLabel : Array[0..11] of Char;
begin
GetVolumeInformation(PChar(WindowsDir+':\'),dLabel,12,@Serial,DirLen,Flags,nil,0);
Result := IntToHex(Serial,8);
end;

//--- Limpa carecteres estranhos do serial
//----------------------------------------
Function LimpaSerial(Dados:String):String;
var
i : Integer;
s : String;
begin
s:= '';
for i := 1 to Length( Dados ) do
begin
if Pos( Copy( Dados, i, 1 ), '/-.()_: ' ) = 0 then
s := s + Copy( Dados, i, 1 );
end;

Result:= s;
end;

//--- Criptografa uma string ------------
//---------------------------------------
function Crypt(Action, Src: String): String;
Label Fim;
var KeyLen : Integer;
KeyPos : Integer;
OffSet : Integer;
Dest, Key : String;
SrcPos : Integer;
SrcAsc : Integer;
TmpSrcAsc : Integer;
Range : Integer;
begin
if (Src = '') Then
begin
Result:= '';
Goto Fim;
end;
Key := 'AFRDEWJQYEERFSRSFSSFF';
Dest := '';
KeyLen := Length(Key);
KeyPos := 0;
SrcPos := 0;
SrcAsc := 0;
Range := 16; //256
if (Action = UpperCase('C')) then
begin
Randomize;
OffSet := Random(Range);
Dest := Format('%1.2x',[OffSet]);
for SrcPos := 1 to Length(Src) do
begin
Application.ProcessMessages;
SrcAsc := (Ord(Src[SrcPos]) + OffSet) Mod 255;
if KeyPos < KeyLen then KeyPos := KeyPos + 1 else KeyPos := 1;
SrcAsc := SrcAsc Xor Ord(Key[KeyPos]);
Dest := Dest + Format('%1.2x',[SrcAsc]);
OffSet := SrcAsc;
end;
end
Else if (Action = UpperCase('D')) then
begin
OffSet := StrToInt('$'+ copy(Src,1,2));
SrcPos := 3;
repeat
SrcAsc := StrToInt('$'+ copy(Src,SrcPos,2));
if (KeyPos < KeyLen) Then KeyPos := KeyPos + 1 else KeyPos := 1;
TmpSrcAsc := SrcAsc Xor Ord(Key[KeyPos]);
if TmpSrcAsc <= OffSet then TmpSrcAsc := 255 + TmpSrcAsc - OffSet
else TmpSrcAsc := TmpSrcAsc - OffSet;
Dest := Dest + Chr(TmpSrcAsc);
OffSet := SrcAsc;
SrcPos := SrcPos + 2;
until (SrcPos >= Length(Src));
end;
Result:= Dest;
Fim:
end;

Function Replica( pString:String; xWidth:Integer ):String;
Var
nCount : Integer;
pStr : String;
begin
pStr := '';
for nCount := 1 to xWidth do pStr := pStr + pString;
Result := pStr;
end;


end.
Responder
×
+1 DevUP
Acesso diário, +1 DevUP
Parabéns, você está investindo na sua carreira