Club Delphi  
    Paypal   FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Coloboración Paypal con ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 11-05-2012
Avatar de kurono
[kurono] kurono is offline
Miembro Premium
 
Registrado: jul 2007
Ubicación: Republica Dominicana
Posts: 1.144
Poder: 20
kurono Va por buen camino
mira este a ver si te funciona nunca lo probe en win7 puede ser q te funcione
Código Delphi [-]
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;

// 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;

EJEMPLO de uso

var
  VendorId: string;
  ProductId: string;
  SerialNumber: string;
  Extraible: Boolean;
  Mensaje: string;
begin
  Mensaje:= GetSerialNumber('C', VendorId, ProductId, SerialNumber, Extraible);
  if Mensaje = EmptyStr then
  begin
    ShowMessage
    (
      'VendorId: '     + VendorID     + #13 +
      'ProductId: '    + ProductId    + #13 +
      'SerialNumber: ' + DecodeSerialNumber(SerialNumber) + #13 +
      'Extraible: '    + BoolToStr(Extraible,TRUE)
     );
  end else
    ShowMessage(Mensaje);
end;
end.
Responder Con Cita
  #2  
Antiguo 19-09-2012
agustinbus agustinbus is offline
Miembro
 
Registrado: ago 2007
Posts: 44
Poder: 0
agustinbus Va por buen camino
Hola como estan! en el ejemplo de Neftali subido al ftp, ¿SerialNumber funciona bajo XP? Lo probe en WIN7 y va muy bien.
Saludos!
Responder Con Cita
  #3  
Antiguo 19-09-2012
Avatar de Casimiro Noteví
Casimiro Noteví Casimiro Noteví is offline
Merodeador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.669
Poder: 10
Casimiro Noteví Tiene un aura espectacularCasimiro Noteví Tiene un aura espectacular
Según se lee más arriba:

Cita:
Empezado por Neftali Ver Mensaje
La clase Win32_DiskDrive debería devolver sin problemas el SerialNumber. En la misma documentación se lee lo siguiente:
"Windows Server 2003, Windows XP, Windows 2000, and Windows NT 4.0: This property is not available."
Responder Con Cita
  #4  
Antiguo 19-09-2012
agustinbus agustinbus is offline
Miembro
 
Registrado: ago 2007
Posts: 44
Poder: 0
agustinbus Va por buen camino
Mil disculpas se me paso por alto. Entonces se podria obtener la version de win instalada y combinar el codigo de neftali con el de darkbits, entonces dependiendo de la version, que use uno u otro codigo para obtener el numero de serie fisico del disco
Responder Con Cita
  #5  
Antiguo 19-09-2012
Avatar de Neftali [Germán.Estévez]
Neftali [Germán.Estévez] Neftali [Germán.Estévez] is online now
[becario]
 
Registrado: jul 2004
Ubicación: Barcelona - España
Posts: 19.437
Poder: 10
Neftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en bruto
Cita:
Empezado por agustinbus Ver Mensaje
Mil disculpas se me paso por alto. Entonces se podria obtener la version de win instalada y combinar el codigo de neftali con el de darkbits, entonces dependiendo de la version, que use uno u otro codigo para obtener el numero de serie fisico del disco
Esa creo que es una muy buena idea, y es la que he propuesto alguna vez en el blog. Para anteriores a W7 usar un sistema alternativo, para W7 y posteriores, WMI es una buena opción.
__________________
Germán Estévez => Web/Blog
Guía de estilo, Guía alternativa
Utiliza TAG's en tus mensajes.
Contactar con el Clubdelphi

P.D: Más tiempo dedicado a la pregunta=Mejores respuestas.
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Mi programa no funciona en Win7 64 Paulao Varios 7 13-03-2012 13:34:21
¿Función para determinar la capacidad del disco duro? Roilo API de Windows 8 30-12-2008 19:07:30
Disco Duro Externo Fenareth Varios 8 25-07-2008 16:45:30
Imagen de disco duro de sistema a un disco externo usb Wonni Windows 20 05-06-2007 13:11:55
Funcion para saber si un registro .dbf esta bloqueado ( en red no me funciona ) Wonni Conexión con bases de datos 7 06-10-2006 18:49:32


La franja horaria es GMT +2. Ahora son las 13:10:56.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi