GetWindows

Delphi

01/02/2013

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.
Rafael Mota

Rafael Mota

Curtidas 0

Respostas

Bruno Leandro

Bruno Leandro

01/02/2013

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 ?
GOSTEI 0
Rafael Mota

Rafael Mota

01/02/2013

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;
GOSTEI 0
Bruno Leandro

Bruno Leandro

01/02/2013

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)
GOSTEI 0
Rafael Mota

Rafael Mota

01/02/2013

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);
GOSTEI 0
Alessandro Folk

Alessandro Folk

01/02/2013

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!
GOSTEI 0
Alisson Santos

Alisson Santos

01/02/2013

Conseguiu sanar a duvida amigo.
GOSTEI 0
Rafael Mota

Rafael Mota

01/02/2013

Ainda não! Você tem alguma dica?
Vlw...
GOSTEI 0
Alessandro Folk

Alessandro Folk

01/02/2013

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!
GOSTEI 0
Rafael Mota

Rafael Mota

01/02/2013

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.
GOSTEI 0
Alessandro Folk

Alessandro Folk

01/02/2013

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!
GOSTEI 0
Rafael Mota

Rafael Mota

01/02/2013

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.
GOSTEI 0
POSTAR