Proteger programa con nº de licencia

[Bauhaus1975]

Hola, sé que se ha hablado bastante sobre este tema, pero no sé si alguien tiene o sabe cómo hacer lo que necesito.

Para proteger un programa con un número de licencia o clave, ¿tiene alguien alguna función que genere claves y pueda validarlas para un tiempo determinado de validez?
Por ejemplo, la idea es entregar un programa a un usuario con una validez de un año, (o un tiempo de prueba) si pasado ese tiempo no ha renovado o contratado el programa debe bloquearse, pero para una clave introducida el programa debe saber el tiempo de validez del que dispone para ejecutarse con esa clave.
No sé si es muy enreversado, pero... ¿alguien puede ayudarme con este tema?
Saludos.

[ContraVeneno]

por algún lado leí aquí en el club sobre este artículo, no lo he probado, pero igual te sirve:

http://delphi.about.com/od/productre.../aa022503a.htm

[[seoane]]

Aquí explique un método rudimentario de hacer lo que quieres:
http://www.clubdelphi.com/foros/show...22&postcount=4

[Bauhaus1975]

En primer lugar gracias a los dos por vuestra ayuda. Os comento algunas cosas referentes al tema:

Sobre el comentario de ContraVeneno, decir que el componente que nos has enseñado tiene buena pinta, pero para poderlo integrar en un programa (y reutilizar su código) habría que pagar, ¿cierto?. La segunda opción propuesta por 'Seoane', es muy buena. Quizá se podría mejorar si se incluye en la clave generada el ID del disco duro u otra información del sistema para que sólo pueda ejecutarse en una misma máquina (incluso salve una clonación del disco)

En este hilo hablan sobre cómo obtener el ID del disco duro.
Seguiré pensando en el tema, gracias por vuestra ayuda.

[ContraVeneno]

no, no hay que pagar por utilizar el componente... por el código fuente sí.

To be honest I'm quite amazed with this component! It's *free*, no free sources though

[martinchooozzz]

una conuslta en cuanto a control sobre tus programas, ahi algun problema con rspecto a lo legal si ponemos en nuestro programa un envio de mail con informacion de la pc donde este se ejecuta como ip mac grupo de trabajo nombre de pc etc. a un mail que nosotros especificamos?

[[eduarcol]]

Empezado por martinchooozzz

una conuslta en cuanto a control sobre tus programas, ahi algun problema con rspecto a lo legal si ponemos en nuestro programa un envio de mail con informacion de la pc donde este se ejecuta como ip mac grupo de trabajo nombre de pc etc. a un mail que nosotros especificamos?

siempre que el cliente lo sepa y lo acepte no veo mayor incoveniente...

[martinchooozzz]

gracias

[elcolo83]

Hola, mira, yo en mi caso lo que hago es cifrar una fecha con AES256 en donde la clave es la suma de la mac, el numero de serie del disco, el tipo de sistema operativo, etc. este cifrado genera una clave alfanumerica la cual le paso al cliente para que ingrese como licencia, cuando el programa inicia, antes de hacer nada lo primero que hace es tratar de descifrar el codigo de la licencia con los datos del disco, etc etc... si esto devuelve una fecha y ademas es posterior a la fecha actual el programa se inicia sin problemas...
otras de las cosas que se puede hacer para que sirva tu licencia es que el programa no se inicie si el usuario retraso la fecha del sistema, guardando el ultimo inicio y restringiendo la cantidad de inicios diarios...

[Bauhaus1975]

Empezado por elcolo83

Hola, mira, yo en mi caso lo que hago es cifrar una fecha con AES256 en donde la clave es la suma de la mac, el numero de serie del disco, el tipo de sistema operativo, etc. este cifrado genera una clave alfanumerica la cual le paso al cliente para que ingrese como licencia

Supongo que formarás tu clave con algun valor que sólo tú conozcas, de
otro modo, teniendo en cuenta que los algoritmos a usar para codificar un valor son pocos, y los datos a usar: tipicamente MAC, ID Disco, ID CPU etc. alguien que se ponga a conciencia podría construir el generador de
claves, ¿cierto?

Otra pregunta: He estado pensando que valor usar para formar esa clave que sea identeficador único de la máquina donde se instale, y no sirva para otras máquinas. Encontré un par de funciones que devuelven el ID del Disco duro
(ojo, el ID de disco y no el id del volumen), una para el caso de discos IDE y otra para discos SCSI, pero no tengo nada en caso de que el disco sea SATA (ya casi la mayoria), y no sé realmente si existe alguna función para
discos SATA ¿Alguien sabe cómo obtener el ID de disco de los SATA?

También he leido que Intel quería dejar de usar el ID de CPU.
¿Visto todo esto cuál creeis que sería la mejor opción para formar esa clave?
Gracias y un saludo.

[elcolo83]

Mira, aca te paso una de la unidades que uso para capturar los datos de la PC y cifrarlos... Fijate en la funcion Generar.

Código Delphi [-]

unit InfoPc;  interface  uses   Windows, SysUtils, NB30;   const   METHOD_BUFFERED = 0;   FILE_ANY_ACCESS = 0;   FILE_DEVICE_MASS_STORAGE = $2D;   IOCTL_STORAGE_BASE = FILE_DEVICE_MASS_STORAGE;    IOCTL_STORAGE_QUERY_PROPERTY =     (IOCTL_STORAGE_BASE shl 16) or (FILE_ANY_ACCESS shl 14) or     ($500 shl 2) or  METHOD_BUFFERED;  type   PSTORAGE_DESCRIPTOR_HEADER = ^TSTORAGE_DESCRIPTOR_HEADER;   TSTORAGE_DESCRIPTOR_HEADER = packed record     Version: ULONG;     Size: ULONG;   end;    PSTORAGE_DEVICE_DESCRIPTOR = ^STORAGE_DEVICE_DESCRIPTOR;   STORAGE_DEVICE_DESCRIPTOR = packed record     Version: ULONG;     Size: ULONG;     DeviceType: UCHAR;     DeviceTypeModifier: UCHAR;     RemovableMedia: Boolean;     CommandQueueing: Boolean;     VendorIdOffset: ULONG;     ProductIdOffset: ULONG;     ProductRevisionOffset: ULONG;     SerialNumberOffset: ULONG;     BusType: ULONG;     RawPropertiesLength: ULONG;     RawDeviceProperties: array[0..0] of UCHAR;   end;   /////////////////////////////////////////////////////////////////////////////////////////////  type   HCRYPTPROV  = ULONG;   PHCRYPTPROV = ^HCRYPTPROV;   HCRYPTKEY   = ULONG;   PHCRYPTKEY  = ^HCRYPTKEY;   HCRYPTHASH  = ULONG;   PHCRYPTHASH = ^HCRYPTHASH;   LPAWSTR     = PAnsiChar;   ALG_ID      = ULONG;  const   CRYPT_NEWKEYSET = $00000008;   PROV_RSA_FULL   = 1;   ALG_TYPE_ANY    = 0;   ALG_CLASS_HASH  = (4 shl 13);   ALG_SID_MD5     = 3;   CALG_MD5        = (ALG_CLASS_HASH or ALG_TYPE_ANY or ALG_SID_MD5);   HP_HASHVAL      = $0002;   ALG_CLASS_DATA_ENCRYPT = (3 shl 13);   ALG_TYPE_STREAM = (4 shl 9);   ALG_SID_RC4     = 1;   CALG_RC4        = (ALG_CLASS_DATA_ENCRYPT or ALG_TYPE_STREAM or ALG_SID_RC4);     function CryptAcquireContext(phProv       :PHCRYPTPROV;                                pszContainer :LPAWSTR;                                pszProvider  :LPAWSTR;                                dwProvType   WORD;                                dwFlags      WORD) :BOOL; stdcall;     external ADVAPI32 name 'CryptAcquireContextA';   function CryptCreateHash    (hProv   :HCRYPTPROV;                                Algid   :ALG_ID;                                hKey    :HCRYPTKEY;                                dwFlags WORD;                                phHash  :PHCRYPTHASH) :BOOL;stdcall;     external ADVAPI32 name 'CryptCreateHash';   function CryptHashData      (hHash             :HCRYPTHASH;                                const pbData      :PBYTE;                                dwDataLen         WORD;                                dwFlags           WORD) :BOOL;stdcall;     external ADVAPI32 name 'CryptHashData';   function CryptEncrypt       (hKey       :HCRYPTKEY;                                hHash      :HCRYPTHASH;                                Final      :BOOL;                                dwFlags    WORD;                                pbData     :PBYTE;                                pdwDataLen :PDWORD;                                dwBufLen   WORD) :BOOL;stdcall;     external ADVAPI32 name 'CryptEncrypt';   function CryptDecrypt       (hKey       :HCRYPTKEY;                                hHash      :HCRYPTHASH;                                Final      :BOOL;                                dwFlags    WORD;                                pbData     :PBYTE;                                pdwDataLen :PDWORD) :BOOL;stdcall;     external ADVAPI32 name 'CryptDecrypt';   function CryptDeriveKey     (hProv     :HCRYPTPROV;                                Algid     :ALG_ID;                                hBaseData :HCRYPTHASH;                                dwFlags   WORD;                                phKey     :PHCRYPTKEY) :BOOL;stdcall;     external ADVAPI32 name 'CryptDeriveKey';   function CryptDestroyHash   (hHash:HCRYPTHASH) :BOOL;stdcall;     external ADVAPI32 name 'CryptDestroyHash';   function CryptReleaseContext(hProv:HCRYPTPROV; dwFlagsWORD):BOOL;stdcall;     external ADVAPI32 name 'CryptReleaseContext';   /////////////////////////////////////////////////////////////////////////////////////////////  function GetMACAdress: string; function GetVolumeSerialNumber(const drive: TFilename): DWord; function GetSerialNumber(Letra: Char; var VendorId: string; var ProductId: string;   var SerialNumber: string; var Extraible: Boolean): string; function encripxor(aStr: String; aKey: Integer): String; function desencripxor(aStr: String; aKey: Integer): String;  function Generar(Clave): String; Procedure CapturaDatos;   implementation  ////////////////////////////////////////////////////////////////////////////////////////////   function encripxor(aStr: String; aKey: Integer): String; begin    Result:='';    RandSeed:=aKey;    for aKey:=1 to Length(aStr) do        Result:=Result+Chr(Byte(aStr[aKey]) xor random(256)); end;   function desencripxor(aStr: String; aKey: Integer): String; begin    Result:='';    RandSeed:=aKey;    for aKey:=1 to Length(aStr) do        Result:=Result+Chr(Byte(aStr[aKey]) xor random(256)); end;   ////////////////////////////////////////////////////////////////////////////////////////////     function Cifrar(Texto, Password: string): string; var   hProv: HCRYPTPROV;   hHash: HCRYPTHASH;   hKey:  HCRYPTKEY;   Success: BOOL;   Buffer: array[0..1024] of Char;   DataLen: DWORD;   i: Integer; begin   Result:= '';   Success:= CryptAcquireContext(@hProv, nil, nil, PROV_RSA_FULL, 0);   if (not Success) then     if GetLastError() = DWORD(NTE_BAD_KEYSET) then       Success:= CryptAcquireContext(@hProv, nil, nil, PROV_RSA_FULL, CRYPT_NEWKEYSET);   if Success then     begin       if CryptCreateHash(hProv, CALG_MD5, 0, 0, @hHash) then         begin           if CryptHashData(hHash, PByte(PChar(Password)), Length(Password), 0) then             if CryptDeriveKey(hProv, CALG_RC4, hHash, $00800000, @hKey) then             begin               FillChar(Buffer,Sizeof(Buffer),0);               StrLCopy(@Buffer,PChar(Texto),Sizeof(Buffer) - 1);               DataLen:= StrLen(@Buffer);               if CryptEncrypt(hKey, 0, TRUE, 0, PByte(@Buffer), @DataLen, Sizeof(Buffer)) then               begin                 for i:= 0 to DataLen - 1 do                   Result:= Result + IntToHex(Byte(Buffer[i]),2);               end;             end;           CryptDestroyHash(hHash);         end;       CryptReleaseContext(hProv,0);     end; end;  function Descifrar(Texto, Password: string): string; var   hProv: HCRYPTPROV;   hHash: HCRYPTHASH;   hKey:  HCRYPTKEY;   Success: BOOL;   Buffer: array[0..1024] of Char;   DataLen: DWORD;   i,j: Integer; begin   Result:= '';   if Length(Texto) = 0 then     Exit;   if Odd(Length(Texto)) then     Exit;   if (Length(Texto) shr 2) > (Sizeof(Buffer) - 1) then     Exit;   i:= 0;   FillChar(Buffer,Sizeof(Buffer),0);   while Length(Texto) > 0 do   begin     if TryStrToInt('$'+copy(Texto,1,2),j) then     begin       Buffer[i]:= Char(j);       Delete(Texto,1,2);       inc(i);     end else Exit;   end;   Success:= CryptAcquireContext(@hProv, nil, nil, PROV_RSA_FULL, 0);   if (not Success) then     if GetLastError() = DWORD(NTE_BAD_KEYSET) then       Success:= CryptAcquireContext(@hProv, nil, nil, PROV_RSA_FULL, CRYPT_NEWKEYSET);   if Success then     begin       if CryptCreateHash(hProv, CALG_MD5, 0, 0, @hHash) then         begin           if CryptHashData(hHash, PByte(PChar(Password)), Length(Password), 0) then             if CryptDeriveKey(hProv, CALG_RC4, hHash, $00800000, @hKey) then             begin               DataLen:= i;               if CryptDecrypt(hKey, 0, TRUE, 0, PByte(@Buffer), @DataLen) then               begin                 Result:= Copy(String(PChar(@Buffer)),1,DataLen);               end;             end;           CryptDestroyHash(hHash);         end;       CryptReleaseContext(hProv,0);     end; end;      ////////////////////////////////////////////////////////////////////////////////////////////   // Descodifica el numero de serie function DecodeSerialNumber(SerialNumber: string): string; var   i: Integer; begin   Result:= EmptyStr;   while Length(SerialNumber) > 0 do   begin     if TryStrToInt('$'+Copy(SerialNumber,1,4),i) then     begin       Result:= Result + Char(Lo(i)) + Char(Hi(i));       Delete(SerialNumber,1,4);     end else     begin       Result:= EmptyStr;       Exit;     end;   end;   Result:= Trim(Result); end;  // Obtiene la informacion sobre el dispositivo // Parametros: //   Letra: Letra de la unidad (A,B,C,D...) //   VendorId: Identificacion del vendedor //   ProductId: Identificacion del producto //   SerialNumber: Numero de serie //   Extraible: Indica si el dispositivo es extraible (disquete, memoria usb) // function GetSerialNumber(Letra: Char; var VendorId: string; var ProductId: string;   var SerialNumber: string; var Extraible: Boolean): string; var   Disk: THandle;   Size: Cardinal;   Buffer: Pointer;   DeviceDescriptor: PSTORAGE_DEVICE_DESCRIPTOR; begin   Result:= EmptyStr;   Disk:= CreateFile(PChar('\\.\' + Letra + ':'),GENERIC_READ,FILE_SHARE_READ     or FILE_SHARE_WRITE,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);   if Disk <> INVALID_HANDLE_VALUE then   begin     GetMem(Buffer,12);     try       FillChar(Buffer^,12,0);       if DeviceIOControl(Disk, IOCTL_STORAGE_QUERY_PROPERTY,         Buffer,12,Buffer,12,Size, nil) then       begin         FreeMem(Buffer);         Size:= PSTORAGE_DESCRIPTOR_HEADER(Buffer).Size;         GetMem(Buffer, Size);         FillChar(Buffer^,Size,0);         if DeviceIOControl(Disk, IOCTL_STORAGE_QUERY_PROPERTY,           Buffer,12,Buffer,Size,Size, nil) then           begin             DeviceDescriptor:= Buffer;             Extraible:= DeviceDescriptor.RemovableMedia;             if DeviceDescriptor.VendorIdOffset > 0 then               VendorId:= String(PChar(Buffer) + DeviceDescriptor.VendorIdOffset)             else               VendorId:= EmptyStr;             if DeviceDescriptor.ProductIdOffset > 0 then               ProductId:= String(PChar(Buffer) + DeviceDescriptor.ProductIdOffset)             else               ProductId:= EmptyStr;             if (DeviceDescriptor.SerialNumberOffset > 0) and                (DeviceDescriptor.SerialNumberOffset < Size) then               SerialNumber:= String(PChar(Buffer) + DeviceDescriptor.SerialNumberOffset)             else               SerialNumber:= EmptyStr;           end else Result:= SysErrormessage(GetLastError);       end else Result:= SysErrormessage(GetLastError);     finally       FreeMem(Buffer);     end;     CloseHandle(Disk);   end else Result:= SysErrormessage(GetLastError); end;    ////////////////////////////////////////////////////////////////////////////////////////////     function GetVolumeSerialNumber(const drive: TFilename): DWord; var VolumeName, FileSystemName: array[0..MAX_PATH-1] of char; VolumeSerialNumber, MaxFilenameLength, FileSystemFlags: DWord; begin GetVolumeInformation(PChar(drive), VolumeName, MAX_PATH, @VolumeSerialNumber, MaxFilenameLength, FileSystemFlags, FileSystemName, MAX_PATH); Result := VolumeSerialNumber; end;   ////////////////////////////////////////////////////////////////////////////////////////////   function GetMACAdress: string; var   NCB: PNCB;   Adapter: PAdapterStatus;    URetCode: PChar;   RetCode: char;   I: integer;   Lenum: PlanaEnum;   _SystemID: string;   TMPSTR: string; begin    Result    := '';    _SystemID := '';    Getmem(NCB, SizeOf(TNCB));   Fillchar(NCB^, SizeOf(TNCB), 0);    Getmem(Lenum, SizeOf(TLanaEnum));   Fillchar(Lenum^, SizeOf(TLanaEnum), 0);    Getmem(Adapter, SizeOf(TAdapterStatus));    Fillchar(Adapter^, SizeOf(TAdapterStatus), 0);     Lenum.Length    := chr(0);    NCB.ncb_command := chr(NCBENUM);    NCB.ncb_buffer  := Pointer(Lenum);    NCB.ncb_length  := SizeOf(Lenum);    RetCode         := Netbios(NCB);     i := 0;    repeat      Fillchar(NCB^, SizeOf(TNCB), 0);     Ncb.ncb_command  := chr(NCBRESET);      Ncb.ncb_lana_num := lenum.lana[i];     RetCode          := Netbios(Ncb);      Fillchar(NCB^, SizeOf(TNCB), 0);     Ncb.ncb_command  := chr(NCBASTAT);     Ncb.ncb_lana_num := lenum.lana[i];     // Must be 16     Ncb.ncb_callname := '*               ';      Ncb.ncb_buffer := Pointer(Adapter);      Ncb.ncb_length := SizeOf(TAdapterStatus);     RetCode        := Netbios(Ncb);     //---- calc _systemId from mac-address[2-5] XOR mac-address[1]...     if (RetCode = chr(0)) or (RetCode = chr(6)) then     begin       _SystemId := IntToHex(Ord(Adapter.adapter_address[0]), 2) + '-' +         IntToHex(Ord(Adapter.adapter_address[1]), 2) + '-' +         IntToHex(Ord(Adapter.adapter_address[2]), 2) + '-' +         IntToHex(Ord(Adapter.adapter_address[3]), 2) + '-' +         IntToHex(Ord(Adapter.adapter_address[4]), 2) + '-' +         IntToHex(Ord(Adapter.adapter_address[5]), 2);     end;     Inc(i);   until (I >= Ord(Lenum.Length)) or (_SystemID <> '00-00-00-00-00-00');   FreeMem(NCB);   FreeMem(Adapter);   FreeMem(Lenum);   GetMacAdress := _SystemID; end;   ////////////////////////////////////////////////////////////////////////////////////////////   function Generar(Clave): String; var usmaq, maq, z, cod, K: string; begin     CapturaDatos;     K:= '?y&1m,£wq@7';  //K es un valor contante para la aplicación     Z:= Clave; //La Clave puede ser una fecha o lo que quieras     Z:= cifrar(Z, K+ SerialNumber.Caption + VendorID.Caption+ProductID.Caption+Extraible.Caption+VolumeSerialNumber.Caption+'V1.1'); //En ocaciones cambio el orden de los elementos de la suma o le agrego  //otros strings result:= Z; end;   Procedure CapturaDatos; var   VendorIdx: string;   ProductIdx: string;   SerialNumberx: string;   Extraiblex: Boolean;   Mensajex: string; begin  with Form1 do begin   MacAdress.Caption := GetMACAdress;   Mensajex:= GetSerialNumber('C', VendorIdx, ProductIdx, SerialNumberx, Extraiblex);   VolumeSerialNumber.Caption:= inttostr(GetVolumeSerialNumber('C:\'));   if Mensajex = EmptyStr then   begin     VendorID.Caption:= VendorIDx;     ProductID.Caption:= ProductIDx;     SerialNumber.Caption:= DecodeSerialNumber(SerialNumberx);     Extraible.Caption:= BoolToStr(Extraiblex,TRUE);   end else     ShowMessage(Mensajex);   if Trim(VendorID.Caption)= '' then VendorID.Caption:= '(No se encontró)';   if Trim(ProductID.Caption)= '' then ProductID.Caption:= '(No se encontró)';   if Trim(SerialNumber.Caption)= '' then SerialNumber.Caption:= '(No se encontró)'; end;   end;   end.

Fijate si te sirve algo de todo esto... =)

[elcolo83]

Evidentemente anda mal el post... no se ve nada bien asi, mil disculpas... los moderadores tendran que ver que paso aca... no se como pasartelo ahora...

[Bauhaus1975]

¿Puedes ponerlo para descarga? o también puedes enviarlo a mi correo...
Como prefieras.
Gracias de nuevo.

[elcolo83]

Ahi te lo mande al correo...

[dec]

Holas,

Los moderadores igual pueden hacer algo... pero, nada que no puedas hacer tú mismo. Es decir, nada te impide editar tu mensaje, hasta que quede como tiene que quedar. Para eso puedes hacer "vistas previas", formatear el código fuente hasta que todo quede "bien", en fin, no dejar la tarea a los moderadores del foro. ¿No te parece?

Comprendo que cuando edites tu mensaje y veas el pifostio que hay montado dirás, ¡madre mía! Esto que lo arregle otro. Pero, igual que yo comprendo eso, ahora ponte tú en mi posición y dime si no te parecerá igual pifostio o peor aún, porque además nosotros no contamoso con el código fuente "original", así que no nos quedaría más remedio que formatear el pifostio disponible.

Disculpa si te mi respuesta te parece odiosa, pero, no es mi intención sino recalcar el hecho de que tú puedes editar tus mensajes (como todos los usuarios de los foros pueden editar sus propios mensajes) y además te será más fácil arreglar el problema a ti que no a los moderadores, que no disponemos del código fuente original. Por otro lado, si lo haces, tal vez hasta evitemos decenas de mensajes pidiéndote que envíes a una dirección de correo el código fuente que ahora mismo es ilegible.

¿Qué te parece? En todo caso, estoy dispuesto a comerme mis palabras si el siguiente código fuente no se muestra correctamente "formateado":

Código PHP:

function __autoload($className){
  global $gbClassDirs;
  if(empty($gbClassDirs)){
    $gbClassDirs = GbClassDirs();
  }
  $class = strtolower($className).
   GB_CLASS_SCRIPT_EXTENSION;
  $const = strtolower($className).
   GB_CLASS_CONSTS_EXTENSION;
  foreach($gbClassDirs as $dir){
    if(is_readable($dir.$class)){
      require($dir.$class);
      if(is_readable($dir.$const)){
        require($dir.$const);
      }
      break;
    }
  }
} 


Código Delphi [-]
{ The main algorithm this component (just bellow) is written for Zarco Gajic
  on Delphi.About (http://delphi.about.com/od/graphics/l/aa120198.htm) Thanks!

  We use "GetSysTemMetrics" instead of variable Screen of Forms.pas unit to
  obtain the width and height of monitor resolution and use a particular Pen
  to the optional crosshair via component property.
}
procedure TCCDZoomPanel.ZoomTimer(sender: TObject);
var
  cnv: TCanvas;
  hDesktop: Hwnd;
  cursorPos: TPoint;
  iTmpX, iTmpY: Real;
  sRect, dRect: TRect;
  sWidth, sHeight, iWidth, iHeight, DmX, DmY: integer;
begin
  iWidth := self.Width;
  iHeight := self.Height;
  GetCursorPos(cursorPos);
  hDesktop:= GetDesktopWindow();
  dRect := Rect(0, 0, iWidth, iHeight);
  iTmpX := iWidth / (FZoomLevel * 4);
  iTmpY := iHeight / (FZoomLevel * 4);
  sRect := Rect(cursorPos.x, cursorPos.y, cursorPos.x, cursorPos.y);
  sWidth := GetSysTemMetrics(SM_CXSCREEN);
  sHeight := GetSysTemMetrics(SM_CYSCREEN);
  InflateRect(sRect, Round(iTmpX), Round(iTmpY));
  // move sRect if outside visible area of the screen
  if (sRect.Left < 0) then OffsetRect(sRect, -Srect.Left, 0);
  if (sRect.Top < 0) then OffsetRect(sRect, 0, -Srect.Top);
  if (sRect.Right > sWidth) then
    OffsetRect(sRect, -(sRect.Right-sWidth), 0);
  if (sRect.Bottom > sHeight) then
    OffsetRect(sRect, 0, -(sRect.Bottom-sHeight));
  cnv := TCanvas.Create();
  try
    cnv.Handle := GetDC(hDesktop);
    self.Canvas.CopyRect(dRect,cnv,sRect);
  finally
    ReleaseDC(hDesktop, cnv.Handle);
    cnv.Free();
  end;
  if FShowCrosshair then begin
    with self.Canvas do begin
      Pen.Width := FCrosshairWidth;
      Pen.Color := FCrosshairColor;
      DmX:= (FZoomLevel * 2) * (cursorPos.X-Srect.Left);
      DmY:= (FZoomLevel * 2) * (cursorPos.Y-Srect.Top);
      MoveTo(DmX - (iWidth div 10), DmY); // -
      LineTo(DmX + (iWidth div 10), DmY); // -
      MoveTo(DmX,DmY - (iHeight div 10)); // |
      LineTo(DmX,DmY + (iHeight div 10)); // |
    end;
  end;
end;

¿Cómo se ve? En todo caso, no tomes esta respuesta (ya demasiado larga, me temo) como algo personal. ¿Eh? No se trata de eso, te lo aseguro. De todas formas, he editado tu mensaje para añadir las etiquetas "DELPHI", que, aunque tú añadiste, por algún motivo se perdieron. Como tú tienes el código fuente original (y supongo que formateado), si quieres, cópialo de nuevo en tu mensaje y prueba a ver qué tal "sale".

[Bauhaus1975]

Muchas gracias, ya lo tengo. Otra pregunta me ronda:
Si cuando entra el usuario se detecta que caducó la licencia ¿dónde puede almacenarse el último acceso o qué hacer para bloquear acceso en posteriores arranques aunque se cambie la fecha del sistema?

[elcolo83]

Hola Dec, Tanto tiempo... No tomo para nada a tu mensaje como personal. En lo que a mi respecta no me gusta para nada el codigo mal escrito o sin las tabulaciones que debe llevar un código legible. He posteado varias veces codigo y use tambien el FTP del foro y es la primera vez que me pasa esto de que quede todo amontonado y junto como si fuera un geroglifico y por eso pedi disculpas.
Dije que lo tendrian que ver los moderadores por dos cosas... una es que el codigo no se muestra como lo edito por masde que intente cualquier cosa (en este caso) y otra es que en mi opinion dentro de las etiquetas Delphi (o de cualquier otro lenguaje) no deverian aparecer las caritas como me paso. Lo que digo no lo digo de mala manera sino que intento hacer una critica constructiva al foro que tanto nos ha dado dia a dia.
Un abrazo


el Colo.

[elcolo83]

Tenes varias opciones:

1) archivos INI
2) archivos XML
3) Registro del sistema
4) un archivo propio
etc..

En cualquiera de los casos recomiendo que cifres los datos con AES256 o alguno parecido usando tambien los datos de la pc. De esa manera si por ejemplo tenes esos datos en un XML y alguien lo copia a otra pc, esos datos no le van a servir para que el programa se inicie.
Yo generalmente guardo:

-FUI //Fecha del ultimo inicio
-CID //Cantidad de Inicios Diarios hechos (Generalmente lo limito a 15)
-LIC //Licencia
-CCJ //Para el caso de programas contables: el ultimo cierre de caja

1) Cuando inicio el programa compruevo que la licencia contenga una fecha mayor a la actual.
2) Comparo FUI con la fecha actual:
-Si es Menor: CID:= 0;
-Si es Igual y CID < 15: CID:= CID+1;
-Si es mayor: CID:= 16; (15+1)
Luego escribo en FUI la fecha actual para actualizar el valor.
3) Compruevo que el valor de CID sea menor o igual que 16 para iniciar el programa.

Esto es solo una de las formas de hacerlo tenes varias formas mas y mucho mas seguras que esta pero esta es facil y funciona bastante bien.

[dec]

Hola,

Bueno. Ahora que lo pienso, siento si mi anterior mensaje pudo molestarte en algún punto. No era mi intención. De todas formas, puedo asegurarte que lo que a ti te ha pasado no es común, pero, tampoco tan extraño, y, puede arreglarse editando el mensaje, si es necesario borrándolo todo y comenzándolo de nuevo (se supone que copiando y pegando, pero, no la parte del código fuente, que parece la problemática). Si todavía así tienes problemas... igual descubrimos un "bug" y podemos por tanto tratar de arreglarlo.

[elcolo83]

estube haciendo pruevas hasta recien con el codigo que queria mandar... y de 10 pruebas 2 salen bien y 8 me cambia el texto y le saca todos los espacios y retornos de linea al mensaje cuando hago la vista previa... sera ese el bug??