# include "fivewin.ch"
* --------------------------------------------------------------------------------------------------------------- *
Function EMPRESA ()
Local oDlg, oFont0, oFont1, oFont2, oFont3, oFont4, oIcono1
Local psPassWord := SPACE ( 08 )
Local psSerial := SPACE ( 18 ) && 010080 2012.10.26V
* 123456789012345678
Local cDrive_USB := " "
Local sSerial_USB := ""
Local lEntrar := .F.
Public oVoice := tOleAuto():New( "Sapi.SPVoice" ) && Para narrar los mensajes en Español
Public SSFMCreateForWrite := 3 && 3, 2, 4, 7
Public psSerial_guid_uuid := "Satellite C655__F07AB69F-7493-DF11-9A18-00266C754CC5" && Mi Portatil con windows 8.1 y no necesita usb de hardkey
Public psSerial_guid_uuid2 := "MS-7181__FFFFFFFF-FFFF-FFFF-FFFF-FFFFFFFFFFFF" && Mi Abaco con Windows_5_XP y no necesita usb de hardkey
REQUEST HB_LANG_ES
HB_LANGSELECT ( "ES" ) && Idioma Español
REQUEST HB_CODEPAGE_ESWIN && Para reconocer la EÑE y ACENTOS en los índices
HB_SetCodePage ( "ESWIN" ) && Para reconocer la EÑE y ACENTOS en los índices
* REQUEST DBFNTX && para trabajar con indices NTX por Default
* REQUEST DBFCDX && para trabajar con indices CDX Estrucurales con los TAGS y los idx independientes al estilo ntx
REQUEST ADS ,; && para trabajar con la tecnologia ADS, mayor velocidad al indexar los archivos
ADSKeyCount ,; &&
ADSKeyNo ,; &&
AdsGetRelKeyPos ,; &&
AdsSetRelKeyPos ,; &&
OrdKeyCount ,; &&
OrdKeyNo &&
RddRegister ( "ADS", 1 ) && Call the ADS Service:
RddSetDefault ( "ADS" ) && Set the RDD Default, just ADS, data file type comes later
AdsSetServerType ( 7 ) && Set the Server type, 1-Local, 2-Remote, 3-Local + Remote, 4-Internet, 5-Internet + Local, 6-Internet + Remote, 7-All of them
AdsSetFileType ( 1 ) && Set the file type , 1- DBF, NTX, dbt
*AdsSetFileType ( 2 ) && Set the file type , 2- DBF, CDX, ftp
*AdsSetFileType ( 3 ) && Set the file type , ADT, ADI, xxx; 4 := VFP
AdsRightsCheck ( .F. ) && le da a tu programa ( y solo a tu programa) privilegios de acceso a todos los directorios del servidor,
&& de tal forma que tus DBF (o ADTs) pueden ir en carpetas que no esten compartidas,
&& con lo cual los usuarios desde los puestos remotos no pueden verlas ni tocarlas ni nada.
DEFINE ICON oIcono1 RESOURCE "ICONO_1"
DEFINE BRUSH oBrush RESOURCE "FONDO_1"
DEFINE FONT oFont0 NAME "TIMES NEW ROMAN" SIZE 0, -09 ITALIC BOLD
DEFINE FONT oFont1 NAME "TIMES NEW ROMAN" SIZE 0, -10 ITALIC BOLD
DEFINE FONT oFont2 NAME "TIMES NEW ROMAN" SIZE 0, -12 ITALIC BOLD
DEFINE FONT oFont3 NAME "TIMES NEW ROMAN" SIZE 0, -16 ITALIC
DEFINE FONT oFont4 NAME "TIMES NEW ROMAN" SIZE 0, -20 ITALIC BOLD
DEFINE DIALOG oDlg FROM 000, 000 TO 500, 258 FONT oFont1 PIXEL BRUSH oBrush ICON oIcono1 ; && Alto * Ancho
TITLE "Validar USB"
@ 023, 013 SAY "Register JEP SyS USB" SIZE 100, 10 FONT oFont4 PIXEL OF oDlg CENTER COLOR nRGB ( 094, 098, 110 ), nRGB ( 255, 099, 071 ) TRANSPARENT
@ 044, 012 GROUP oGroup TO 118, 114 PROMPT "" FONT oFont0 OF oDlg PIXEL COLOR nRGB ( 255, 140, 000 ), nRGB ( 074, 174, 197 ) && TRANSPARENT && Naranja, Verde
@ 049, 013 SAY "Drive_USB" SIZE 045, 10 FONT oFont2 PIXEL OF oDlg CENTER COLOR nRGB ( 240, 240, 128 ), nRGB ( 255, 099, 071 )
@ 060, 013 SAY "Password Empresa" SIZE 045, 10 FONT oFont2 PIXEL OF oDlg CENTER COLOR nRGB ( 240, 240, 128 ), nRGB ( 255, 099, 071 )
@ 071, 013 SAY "Serial Empresa" SIZE 045, 10 FONT oFont2 PIXEL OF oDlg CENTER COLOR nRGB ( 240, 240, 128 ), nRGB ( 255, 099, 071 )
@ 049, 059 GET ocDrive_USB VAR cDrive_USB PICTURE "@S01" SIZE 010, 10 FONT oFont2 PIXEL OF oDlg COLOR nRGB ( 240, 240, 128 ), nRGB ( 255, 099, 071 )
@ 060, 059 GET opsPassWord VAR psPassWord PICTURE "@S08" SIZE 045, 10 FONT oFont2 PIXEL OF oDlg COLOR nRGB ( 240, 240, 128 ), nRGB ( 255, 099, 071 ) && PASSWORD
@ 071, 059 GET opsSerial VAR psSerial PICTURE "@S18" SIZE 055, 10 FONT oFont2 PIXEL OF oDlg COLOR nRGB ( 240, 240, 128 ), nRGB ( 255, 099, 071 ) && PASSWORD
@ 082, 013 GET osSerial_USB VAR sSerial_USB SIZE 100, 35 FONT oFont2 PIXEL OF oDlg COLOR nRGB ( 240, 240, 128 ), nRGB ( 004, 140, 190 ) ;
MEMO
* ********************************************* Aceptar / Cancelar ********************************************** *
@ 118, 012 BTNBMP RESOURCE "fwbacept", "fwbacep1" SIZE 45, 14 PIXEL OF oDlg ;
MESSAGE "Access Company Authorized" ;
TOOLTIP "Click para que el sistema valide" + CRLF + ;
"la Clave de la Empresa" ;
ACTION ( sSerial_USB := Serial_USB ( cDrive_USB ), osSerial_USB:Refresh () ) && ,;
* IIF ( LEN ( ALLTRIM ( sSerial_USB ) ) > 0, Validar_Empresa ( @psPassWord, @psSerial, opsSerial, sSerial_USB, oDlg ), ) )
@ 118, 058 BTNBMP RESOURCE "fwbcance", "fwbcance1" SIZE 45, 14 PIXEL OF oDlg ;
MESSAGE "Cancelar Dialogo Validación de una USB" ;
TOOLTIP "Click para Cancelar el Dialogo" + CRLF + ;
"Validación de una USB" ;
ACTION ( oDlg:End () )
@ 118, 100 BTNBMP FILENAME "fwbmicrofono.bmp", "fwbmicrofono.bmp" SIZE 17, 14 PIXEL OF oDlg ;
MESSAGE "Narrador acción" ;
TOOLTIP "Click para oir elnarrador de lka acción" + CRLF + ;
"leer la clave del usuario" ;
ACTION ( sMensaje := "Digite la letra de la unidad donde va a instalar la llave de seguridad USB." + CRLF + ;
"y haga click en ACEPTAR para ve la identificación y el serial de la USB." ,;
MsgInfo_Voice ( sMensaje, "Serial de la USB", "3", , , ) )
@ 223, 053 BUTTON oAuto PROMPT "Auto" SIZE 020, 006 FONT oFont0 PIXEL OF oDlg && ACTION ( Automatic( oMeter2, @nActual2 ) )
@ 213, 009 SAY 'Cols: ' + TRANSFORM ( GetSysMetrics ( 0 ) , '99,999' ) + ' * ' + ;
'Rows: ' + TRANSFORM ( GetSysMetrics ( 1 ) , '99,999' ) SIZE 060, 007 FONT oFont0 PIXEL OF oDlg CENTER ;
COLOR nRGB ( 016, 016, 016 ), nRGB ( 222, 227, 230 ) && Letras / Fondo
* ********************************************* Aceptar / Cancelar ********************************************* *
ACTIVATE DIALOG oDlg CENTER
oDlg:End ()
oFont0:End ()
oFont1:End ()
oFont2:End ()
oFont3:End ()
oFont4:End ()
Return ( NIL ) && EMPRESA ()
* --------------------------------------------------------------------------------------------------------------- *
* --------------------------------------------------------------------------------------------------------------- *
Function MsgInfo_Voice ( sA, sTitulo, cC, oDlg, file_mp3, nttime )
DEFAULT nttime := 3
* IF ! IsWin7 ()
IF cWinVersion () > "7"
oVoice:Speak ( sA )
ENDIF
DO CASE
CASE cC = "0"
CASE cC = "1"; MsgInfo ( sA, sTitulo )
*CASE cC = "2"; Mensaje_MP3 ( oDlg, file_mp3 )
CASE cC = "3"; MsgWait ( sA, sTitulo, nttime )
ENDCASE
Return ( NIL )
* --------------------------------------------------------------------------------------------------------------- *
* --------------------------------------------------------------------------------------------------------------- *
Function Serial_USB ( cDrive_USB )
Local sMensaje := sAntecedente := ""
Local sUnidad := " "
sUnidad := UPPER ( cDrive_USB ) && X
IF LEN ( sUnidad ) == 1; sUnidad += ":" ; ENDIF && X:
IF LEN ( sUnidad ) > 2; sUnidad := SUBSTR ( sUnidad, 1, 2 ); ENDIF && X:
sMensaje := Get_Identificacion_Drive_1 ( sUnidad, @sAntecedente ) + CRLF
IF LEN ( ALLTRIM ( sMensaje ) ) > 2
sLinea := sAntecedente && + CRLF
sFile := "1_" + cDrive_USB + "_register_usb.txt" && pfSerial
IF FILE ( sFile )
FATTRIB ( sfile, 00 )
FERASE ( sFile )
ENDIF
NDOSNUME := FCREATE ( sFile, 1 ) && FO_READ := 0, FO_WRITE := 1, READWRITE := 2
FWRITE ( NDOSNUME, sLinea )
FCLOSE ( NDOSNUME )
ELSE
sTexto := "No hay un Pen Drive USB instalado, en alguno de los puertos USB." + CRLF + ;
"por favor instale una memoria para la llave de seguridad."
MsgInfo_Voice ( sTexto, "Serial de la USB", "3" )
ENDIF
Return ( sAntecedente )
* --------------------------------------------------------------------------------------------------------------- *
* --------------------------------------------------------------------------------------------------------------- *
Static Function Get_Identificacion_Drive_1 ( sUnidad, sAntecedente ) && H:, string
Local oLocator := CreateObject ( "wbemScripting.SwbemLocator" )
Local oServer := oLocator:ConnectServer ()
Local aUnidades := oServer:ExecQuery ( "SELECT * FROM Win32_LogicalDiskToPartition" ) && todas las unidades
Local oJob && Indice del FOR
Local cDriverNumber && Número del Drive
Local sPNPDeviceID := "" && ID PNP del Dispositivo
FOR EACH oJob IN aUnidades
IF sUnidad == STRTOKEN ( oJob:Dependent, 2, '"' ) && X: == X:
cDriverNumber := SUBSTR ( STRTOKEN ( STRTOKEN ( oJob:Antecedent, 2, '"' ), 1, "," ), 7 ) && 0, 1, 2, 3
sPNPDeviceID := Get_PNPDeviceID_1 ( oServer, cDriverNumber, @sAntecedente, sUnidad, "USB" )
ENDIF
NEXT
Return ( sPNPDeviceID )
* --------------------------------------------------------------------------------------------------------------- *
* --------------------------------------------------------------------------------------------------------------- *
Static Function Get_PNPDeviceID_1 ( oServer, cDriverNumber, sAntecedente, sUnidad, sTipo_Drive ) &&
Local aDrivers := oServer:ExecQuery ( "SELECT * FROM Win32_DiskDrive" )
Local oDriver, sPNPDeviceID := ""
FOR EACH oDriver IN aDrivers
IF oDriver:Name == "\\.\PHYSICALDRIVE" + cDriverNumber .AND. ;
oDriver:InterfaceType == sTipo_Drive && "USB"
sSerialDrive := Serial_Drive ( oServer, sUnidad ) && averiguar el serial del dispositivo
sPNPDeviceID := oDriver:PNPDeviceID && USBSTOR\DISK&VEN_KINGSTON&PROD_DATATRAVELER_2.0&REV_1.00\0019E06B4A04FD30D73E6051&0
sIntermedio := SUBSTR ( sPNPDeviceID, AT ( "_", sPNPDeviceID ) + 1 ) && Extraer desde el fabricante del dispositivo KINGSTON&PROD_DATATRAVELER_2.0&REV_1.00\0019E06B4A04FD30D73E6051&0
sIntermedio += "--" + sSerialDrive && KINGSTON&PROD_DATATRAVELER_2.0&REV_1.00\0019E06B4A04FD30D73E6051&0--68F2-1519
sAntecedente := sIntermedio
Return ( sPNPDeviceID )
ENDIF
NEXT
Return ( sPNPDeviceID )
* --------------------------------------------------------------------------------------------------------------- *
* --------------------------------------------------------------------------------------------------------------- *
STATIC Function Serial_Drive ( oServer, cDrive )
Local oDisco := oServer:ExecQuery ( "Select * FROM Win32_LogicalDisk" ) && 04 Name, SystemName, VolumeSerialNumber
Local oDatos && Control del indice del FOR
Local sSerial := ""
FOR EACH oDatos IN oDisco
IF cDrive = ALLTRIM ( cVALTOCHAR ( oDatos:Name ) ) && X: == X:
sSerial := ALLTRIM ( cVALTOCHAR ( oDatos:VolumeSerialNumber ) ) && Serial de cada Disco Duro o Partición
IF LEN ( ALLTRIM ( sSerial ) ) > 0
sSerial := SUBSTR ( sSerial, 1, 4 ) + "-" + SUBSTR ( sserial, 5, 4 ) && ABCD-1234
ENDIF
ENDIF
NEXT
Return ( sSerial )
* --------------------------------------------------------------------------------------------------------------- *
* --------------------------------------------------------------------------------------------------------------- *
# include "_hb_340.ch" && para hacer la compatibildad con harbour 3.4
* --------------------------------------------------------------------------------------------------------------- *
*
*
*
*