Code: Select all
#include "FiveWin.ch"
#include "dll.ch"
#DEFINE WM_SYSCOMMAND 274 // &H112
#DEFINE SC_TASKLIST 61744 //&HF130
#DEFINE SC_SCREENSAVE 61760 // &HF140
#DEFINE SW_HIDE 0 // &H0
#DEFINE SW_SHOWNA 8 // &H8
#DEFINE SW_SHOW 5 // &H5
#DEFINE SW_SHOWNORMAL 1
#DEFINE SC_MONITORPOWER 61808 //&HF170 Gracias a Ramon Ramirez por la info
#DEFINE SM_CLEANBOOT 67
#DEFINE GWL_EXSTYLE (-20)
#DEFINE WS_EX_LAYERED 0x00080000
#DEFINE LWA_ALPHA 0x00000002
#DEFINE LWA_COLORKEY 0x00000001
#DEFINE GW_CHILD 5
#DEFINE GW_HWNDNEXT 2
#DEFINE RT_BITMAP 2
#DEFINE MB_ICONEXCLAMATION 48
#DEFINE CBM_INIT 4 && should move to prg header
#DEFINE DIB_RGB_COLORS 0 && should move to prg header
STATIC hLib, hDib
STATIC oHBWnd, oHBBrw, oTray, oIcon, oIcon1
Function main(_tempo_)
local oB, oTimer, cImgFile := "service.bmp", oClp, oBmp
public oFaxServer, oFaxDoc
public cUsuario := NetName(), cImage, cIMGAlerta, oEsconde, strComputer
public TelaMTopo, TelaMEsque, ResLargura := 467, ResAltura := 404, cEsconde := "SIM"
lStatus := .f.
Default _tempo_ := "1"
if IsWin95() .or. IsWin95SP1() .or. IsWin95OSR2() .or. IsWin98() .or. IsWin98SP1() .or. IsWin98SE() .or. IsWinME()
MsgStop( "Desculpe. Este software foi desenhado para Windows XP, 2000 e 2003" )
return .t.
endif
if empty(GetPrinters())
Control('shell32.dll,SHHelpShortcuts_RunDLL AddPrinter',oHBWnd)
return .t.
endif
//if ! file( cDocumento ) .or. cTelefone = NIL
// errhandle = fcreate("hbfax.log")
// fwrite(errhandle,"ERRO: O documento "+cDocumento+" nao existe ou faltou o telefone.")
// fclose(errhandle)
// return .t.
//endif
cPath := cFilePath( GetModuleFileName( GetInstance() ) )
nTempo := VerifyINI( "SERVICE", "TEMPO" , "001", cPath+"service.ini" )
cImage := VerifyINI( "SERVICE", "IMAGEM", "NAO", cPath+"service.ini" )
cIMGAlerta := VerifyINI( "SERVICE", "ALERTA", "SIM", cPath+"service.ini" )
cEsconde := VerifyINI( "PROGRAMA" , "ESCONDE", cEsconde , cPath+"service.ini" )
TelaMTopo := Val(VerifyINI( "PROGRAMA" , "COORDT" , "000" , cPath+"service.ini" ))
TelaMEsque := Val(VerifyINI( "PROGRAMA" , "COORDL" , "000" , cPath+"service.ini" ))
ResAltura := Val(VerifyINI( "PROGRAMA" , "COORDH" , str(ResAltura) , cPath+"service.ini" ))
ResLargura := Val(VerifyINI( "PROGRAMA" , "COORDW" , str(ResLargura) , cPath+"service.ini" ))
ResAltura := ResAltura - TelaMTopo
ResLargura := ResLargura - TelaMEsque
if cEsconde = "SIM"
HBFaxLogo()
endif
if !file("hbfax.dbf")
DbCreate("hbfax.dbf",{ { "Usuario" , "C", 15, 0 },;
{ "Arquivo" , "C", 40, 0 },;
{ "Data" , "C", 8, 0 },;
{ "Hora" , "C", 8, 0 },;
{ "telefone" , "C", 20, 0 },;
{ "titulo" , "C", 20, 0 },;
{ "trabalho" , "N", 10, 0 },;
{ "tipo" , "C", 10, 0 },;
{ "email" , "C", 60, 0 },;
{ "prioridade", "N", 1, 0 },;
{ "Enviado" , "C", 1, 0 } } )
endif
USE hbfax NEW SHARED
dbGoTop()
if recco() = 0
dbAppend() // Adiciona usuario a lista
hbfax->arquivo := "hbfax.txt"
hbfax->data := dtos(date())
hbfax->hora := time()
hbfax->telefone := "11-3909-7179"
hbfax->titulo := "Konectiva HBFax Server"
hbfax->enviado := "N"
dbCommit()
endif
//HDSerial := HDSerial()
//locate for alltrim(acessos->serial) = alltrim(HDSerial)
//if .not. found()
// MsgGet( "Configuracao", "Nick do Usuario:", @cUsuario )
// dbNetAppend( 0 ) // Adiciona usuario a lista
// acessos->Data := Date() // coloca a data do dia do acesso
// acessos->Usuario := cUsuario // coloca o nome do usuario
// acessos->Serial := HDSerial // coloca o nome do usuario
// acessos->Status := .F. // e autentica o usuario mas nao libera
// dbNetReglock()
//else
// lStatus := acessos->Status // verifica se o usuario esta liberado
//endif
//dbSelectArea( "acessos" )
//set filter to alltrim(acessos->serial) = alltrim(HDSerial)
//dbGoTop()
//---------------
ServiceProcess(1)
//---------------
DEFINE BRUSH oB COLOR CLR_HGRAY
DEFINE ICON oIcon RESOURCE "hbfaxon"
DEFINE ICON oIcon1 RESOURCE "hbfaxoff"
DEFINE BITMAP oBmp FILE "hbfax.bmp"
hDC := oBmp:hDC
hBmp := ReadBitmap( 0, "hbfax.bmp" )
if .not. IsActivex( "FaxServer.FaxServer" )
? "Servico de Fax do Windows 2000/2003 nao esta ativado."
endif
oFaxServer:= TOleAuto():New( "FaxServer.FaxServer" )
oFaxServer:Connect( NetName() )
oFaxServer:ServerCoverpage := 0
DEFINE WINDOW oHBWnd FROM TelaMTopo,TelaMEsque to ResLargura,ResAltura pixel TITLE "HBFax Server" ICON "hbfaxon"
DEFINE BUTTONBAR oBar OF oHBWnd
DEFINE BUTTON OF oBar ACTION fun() // ShowClient()
@ 1, 1 BITMAP oBmp FILENAME "hbfax.bmp" ADJUST SIZE 258, 401 OF oHBWnd NOBORDER
//ON CLICK ( oBmp:lStretch := ! oBmp:lStretch, oBmp:Refresh( .t. ) )
//@ 2, 0 LISTBOX oHBBrw FIELDS OF oHBWnd SIZE 500, 500 // ON CHANGE ChangeClient()
//oHBWnd:SetControl( oHBBrw )
oHBWnd:nStyle := 1
SET MESSAGE OF oHBWnd TO "HBFax Server Free - Konectiva Automacao" CLOCK DATE
DEFINE TIMER oTimer OF oHBWnd INTERVAL (val(_tempo_)*60000) ACTION GravaProcess( cImgFile, oHBWnd )
ACTIVATE TIMER oTimer
ACTIVATE WINDOW oHBWnd ;
VALID Sair(oHBWnd) ;
ON RESIZE ( oBmp:Center(), SysRefresh() ) ;
ON INIT (oHBWnd:Move( TelaMTopo,TelaMEsque,ResLargura,ResAltura, .t. ), oTray := TTrayIcon():New(oHBWnd,oIcon1,"HBFax Server rodando...",{||(HBFaxLogo())},{|nRow,nCol|MenuTray(nRow,nCol,oTray)}),iif(cEsconde="SIM",oHBWnd:Hide(),oHBWnd:Show()))
oFaxServer:Disconnect()
oFaxServer:End()
Return NIL
function SalvaCoordenadas(oWnd)
VerifyINI( "PROGRAMA", "COORDT", GetWndRect(oWnd:hWnd)[1], cPath+"service.ini", .t. )
VerifyINI( "PROGRAMA", "COORDL", GetWndRect(oWnd:hWnd)[2], cPath+"service.ini", .t. )
VerifyINI( "PROGRAMA", "COORDH", GetWndRect(oWnd:hWnd)[3], cPath+"service.ini", .t. )
VerifyINI( "PROGRAMA", "COORDW", GetWndRect(oWnd:hWnd)[4], cPath+"service.ini", .t. )
return nil
function MenuTray( nRow, nCol, oTray )
local oMenu
MENU oMenu POPUP
MENUITEM "Configura Impressora" ACTION PrinterSetup()
SEPARATOR
MENUITEM "Mostra aplicativo" ACTION ( oHBWnd:Show(), cEsconde:=VerifyINI( "PROGRAMA", "ESCONDE", "NAO", cPath+"service.ini", .t. ), oHBWnd:SetFocus() )
MENUITEM "Esconde aplicativo" ACTION ( oHBWnd:Hide(), cEsconde:=VerifyINI( "PROGRAMA", "ESCONDE", "SIM", cPath+"service.ini", .t. ) )
SEPARATOR
if ! HBFaxRegistrado()
MENUITEM "Registra aplicativo" ACTION HBFaxRegistra()
SEPARATOR
endif
MENUITEM "Fecha aplicativo" ACTION oHBWnd:end()
ENDMENU
ACTIVATE POPUP oMenu AT nRow, nCol OF oTray:oWnd
return nil
function Sair(oWndMain)
if MsgYesNo( "Clique em SIM para Minimizar esta tela."+chr(13)+"Clique em NAO para sair do aplicativo." )
oWndMain:Hide()
return .f.
else
SalvaCoordenadas(oHBWnd)
oTray:End()
endif
return .t.
function HBFaxLogo()
MsgLogo( "HBFax.bmp", 5 )
return .t.
function fun()
return nil
function HBFaxRegistra()
local oActiveX, cLiberationKey := space(8)
//oActiveX = TActiveX():New( oHBWnd, "nslock15vb5.ActiveLock" )
//oActiveX:SetProp( "SoftwareName" , "hbfaxfree" )
//oActiveX:SetProp( "Password" , "fivolution" )
//oActiveX:SetProp( "LiberationKeyLength", 8 )
//oActiveX:SetProp( "SoftwareCodeLength" , 8 )
//ActXSetLocation( oActiveX:hActiveX, 10, 10, 10, 10 )
//if ! oActiveX:GetProp( "RegisteredUser" )
// MsgGet( "Entre a chave de liberacao",; // Title
// "Chave: ("+oActiveX:GetProp( "SoftwareCode" )+")",; // Label
// @cLiberationKey ) // A variable by reference
// oActiveX:SetProp( "LiberationKey", alltrim(cLiberationKey) )
// //oActiveX:Do( "Register", alltrim(cLiberationKey) )
//endif
//iif( oActiveX:GetProp( "RegisteredUser" ), "Registrado", "Ainda nao registrado" )
//if ! oActiveX:GetProp( "RegisteredUser" )
// if oActiveX:GetProp( "LastRunDate" ) > date()
// MsgRun( 'Data foi retrocedida. Programa sera encerrado' )
// else
// MsgRun( 'Voce tem ' + alltrim(Str( 30 - oActiveX:GetProp( "UsedDays" ) )) + ' dias para registrar.' )
// endif
// //oWnd:cCaption := 'HBFax Server - Nao Registrado'
// SysRefresh()
//else
// //oWnd:cCaption := 'HBFax Server - Registrado'
// SysRefresh()
//endif
////oWnd:oClient = oActiveX // To fill the entire window surface
return nil
function HBFaxRegistrado()
local oActiveX, cLiberationKey := space(8), oHBXWnd
//DEFINE BRUSH oXB COLOR CLR_HGRAY
//DEFINE WINDOW oHBXWnd FROM -1,-1 to 1,1 pixel BRUSH oXB STYLE WS_POPUP
// oActiveX = TActiveX():New( oHBXWnd, "nslock15vb5.ActiveLock" )
// oActiveX:SetProp( "SoftwareName" , "hbfaxfree" )
// oActiveX:SetProp( "Password" , "fivolution" )
// oActiveX:SetProp( "LiberationKeyLength", 8 )
// oActiveX:SetProp( "SoftwareCodeLength" , 8 )
//ACTIVATE WINDOW oHBXWnd ON INIT oHBXWnd:Hide()
return .t. //iif( oActiveX:GetProp( "RegisteredUser" ), .t., .f. )
//-------------------------------------
Function GravaProcess( cImgFile, oHBWnd )
//-------------------------------------
dbSelectArea( "hbfax" )
dbGoTop()
do while .not. eof()
cDocumento := alltrim( hbfax->arquivo )
cTitulo := alltrim( hbfax->titulo )
cTelefone := alltrim( hbfax->telefone )
if hbfax->Enviado # "S" .and. ".TXT" $ upper( cDocumento )
oTray:SetIcon(oIcon)
oTray:Refresh()
*
* oFaxServer:= TOleAuto():New( "FaxServer.FaxServer" )
* oFaxDoc := TOleAuto():New( "FaxServer.FaxDoc" )
* oFaxServer:Connect( NetName() )
* oFaxServer:ServerCoverpage := 0
*
oFaxDoc := TOleAuto():New( "FaxServer.FaxDoc" )
oFaxDoc := oFaxServer:CreateDocument(cDocumento)
oFaxDoc:FaxNumber := alltrim( cTelefone )
oFaxDoc:FileName := alltrim( cDocumento )
oFaxDoc:DisplayName := alltrim( cTitulo )
oFaxDoc:SendCoverPage := .f.
nJob := oFaxDoc:Send()
oFaxDoc:End()
*
* oFaxServer:Disconnect()
* oFaxServer:End()
*
SysWait(2)
* WinExec( [hbfax.exe "]+cDocumento+[" "]+cTitulo+[" "]+cTelefone+["], 7 )
RLock()
hbfax->Usuario := NetName()
hbfax->Enviado := "S"
hbfax->trabalho := nJob
dbCommit()
oTray:SetIcon(oIcon1)
oTray:Refresh()
//Ballon([hbfax.exe "]+cDocumento+[" "]+cTitulo+[" "]+cTelefone+["],2)
endif
skip
enddo
Return NIL
//-------------------------------------
Function ServiceProcess( mode )
//-------------------------------------
Local nProcessId := 0
Default mode := 0
nProcessId := GCP( )
If Abs( nProcessId ) > 0
RSProcess( nProcessId, mode )
Endif
RETURN
//-------------------------------------
Function Ballon(cBallonMsg,nBallonTime)
//-------------------------------------
local oDlgBallon, oBrush
default cBallonMsg := "Nova mensagem chegando..."
DEFINE WINDOW oDlgBallon ;
FROM GetSysMetrics(1),GetSysMetrics(0)-300 TO 200,200 PIXEL ;
COLOR nRGB(255,255,255),nRGB(255,255,230) ;
NO CAPTION BORDER NONE
@ 5, 5 GET cBallonMsg MEMO OF oDlgBallon SIZE 195,195 PIXEL COLOR nRGB(000,000,000),nRGB(255,255,230) NOBORDER NO MODIFY NO VSCROLL
//ACTIVATE WINDOW oDlgBallon ON INIT ( LayeredWindow( oDlgBallon, 070 ), MoveDLG(oDlgBallon,nBallonTime) )
ACTIVATE WINDOW oDlgBallon ON INIT MoveDLG(oDlgBallon,nBallonTime)
return nil
//-------------------------------------
Function LayeredWindow( oHBWnd, nLay )
//-------------------------------------
//SetWindowLong( oHBWnd:hWnd, GWL_EXSTYLE, GetWindowLong( oHBWnd:hWnd, GWL_EXSTYLE ) | WS_EX_LAYERED )
//SetWindowLong( oHBWnd:hWnd, GWL_EXSTYLE, WS_BORDER )
//SetWindowLong( oHBWnd:hWnd, GWL_EXSTYLE, WS_EX_LAYERED )
//SetLayeredWindowAttributes( oHBWnd:hWnd, 0, ( 255 * nLay ) / 100, LWA_ALPHA )
Return NIL
//-------------------------------------
Function dbNetCommit( tempo )
//-------------------------------------
private sempre
dbCommit()
dbRUnlock() // tenta incluir registro
if RLock() // se conseguiu
mensagem(" Aguarde... Tentando liberar o registro")// se nao conseguiu
sempre = (tempo = 0) // fica tentando inclusao
for i = 1 to 10 // ate o tempo esgotar ou
dbRUnlock() // o usuario se encher...
if .not. neterr()
return .t.
endif
inkey(.5) && espera 1/2 segundo
tempo = tempo - .5
next
endif
return (.f.) && nao bloqueado
//-------------------------------------
Function dbNetAppend( tempo )
//-------------------------------------
private sempre
dbappend() // tenta incluir registro
if .not. neterr() // se conseguiu
return (.t.) // retorna verdadeiro
endif
mensagem(" Aguarde... Tentando Acesso aos Arquivos ") // se nao conseguiu
sempre = (tempo = 0) // fica tentando inclusao
do while (sempre .or. tempo > 0) .and. inkey()<>27 // ate o tempo esgotar ou
dbappend() // o usuario se encher...
if .not. neterr()
return .t.
endif
inkey(.5) && espera 1/2 segundo
tempo = tempo - .5
enddo
return (.f.) && nao bloqueado
//-------------------------------------
Function dbNetReglock( tempo )
//-------------------------------------
private sempre
if rlock()
return (.t.) && bloqueado
endif
dbUnlockAll()
mensagem(" Aguarde... Tentando Acesso aos Arquivos ")
sempre = (tempo = 0)
do while (sempre .or. tempo > 0) .and. inkey()<>27
if rlock()
return (.t.) && bloqueado
endif
inkey(.5) && espera 1/2 segundo
tempo = tempo - .5
enddo
return (.f.) && nao bloqueado
//-------------------------------------
Function MoveDLG(oDlgBallon,oDlgTime)
//-------------------------------------
oDlgAltura := GetSysMetrics(1)
for i = 1 to 20
oDlgAltura := oDlgAltura - i
oDlgBallon:Move( oDlgAltura, 100, 200, 200, .t. )
SysWait(.02)
next
SysWait(oDlgTime)
for i = 1 to 20
oDlgAltura := oDlgAltura + i
oDlgBallon:Move( oDlgAltura, 100, 200, 200, .t. )
SysWait(.02)
next
oDlgBallon:end()
return
//-------------------------------------
Function HDSERIAL()
//-------------------------------------
return substr(alltrim(str(nSerialHD())),1,8)
//-------------------------------------
Function MENSAGEM( MENSAGEM, TEMPO )
//-------------------------------------
if tempo <> NIL
MsgStop( OemToAnsi(MENSAGEM) )
else
MsgRun( OemToAnsi(MENSAGEM) )
endif
//-------------------------------------
Function Ping(DestinationAddress)
//-------------------------------------
local IcmpHandle,Replicas
local RequestData:="Testando ping",;
RequestSize:=15,;
RequestOptions:="",;
ReplyBuffer:=space(278),;
ReplySize:=278,;
Timeout:=500 && Milisegundos de espera
default DestinationAddress := "10.10.10.3"
DestinationAddress:=left(alltrim(DestinationAddress)+space(15),15)
//MsgGet("Ping...","Introduzca dirección IP",@DestinationAddress)
IcmpHandle:=IcmpCreateFile()
Replicas:=IcmpSendEcho(IcmpHandle,;
inet_addr(DestinationAddress),;
RequestData,;
RequestSize,0,;
ReplyBuffer,;
ReplySize,;
Timeout)
IcmpCloseHandle(IcmpHandle)
if Replicas > 0
msginfo("A maquina "+alltrim(DestinationAddress)+" existe")
else
msginfo("A maquina "+alltrim(DestinationAddress)+" nao existe")
endif
return nil
//----------------------------------------------------
DLL32 FUNCTION RSProcess(npID AS LONG ,nMode AS LONG ) AS LONG FROM "RegisterServiceProcess" LIB "kernel32.DLL"
DLL32 FUNCTION GCP() AS LONG FROM "GetCurrentProcessId" LIB "kernel32.dll"
DLL32 STATIC FUNCTION FISAVE( nFormat AS LONG, hDib AS LONG, cFileName AS LPSTR, nFlags AS LONG ) AS BOOL PASCAL FROM "_FreeImage_Save@16" LIB hLib
//----------------------------------------------------
DLL32 FUNCTION WSAGetLastError() AS _INT PASCAL FROM "WSAGetLastError" LIB "wsock32.dll"
DLL32 FUNCTION inet_addr(cIP AS STRING) AS LONG PASCAL FROM "inet_addr" LIB "wsock32.dll"
DLL32 FUNCTION IcmpCreateFile() AS LONG PASCAL FROM "IcmpCreateFile" LIB "icmp.dll"
DLL32 FUNCTION IcmpCloseHandle(IcmpHandle AS LONG) AS LONG PASCAL FROM "IcmpCloseHandle" LIB "icmp.dll"
DLL32 FUNCTION IcmpSendEcho(IcmpHandle AS LONG,;
DestinationAddress AS LONG,;
RequestData AS STRING,;
RequestSize AS LONG,;
RequestOptions AS LONG,;
ReplyBuffer AS LPSTR,;
ReplySize AS LONG,;
Timeout AS LONG) AS LONG PASCAL FROM "IcmpSendEcho" LIB "icmp.dll"
//-------------------------------------
Function Control(cString,oHBWnd)
//-------------------------------------
Local Result := ShellExecute(oHBWnd:hWnd, nil,GetWinDir()+'\system32\rundll32.exe',;
cString, nil, SW_SHOW)
RETURN NIL
//-------------------------------------
Function GetPrinters()
//-------------------------------------
Local aPrinter := {}
Local cAllEntries
Local cEntry
Local nStart
Local cName
Local cPrn
Local cPort
Local nJ
cAllEntries := STRTRAN( GetProfString( "Devices" ), Chr( 0 ), CRLF )
For nStart := 1 To MlCount( cAllEntries )
cName := MemoLine( cAllEntries,,nStart)
cEntry := GetProfString( "Devices",cName,"")
nJ := 2
Do While ! Empty(cPort := StrToken(cEntry,nJ++,","))
Aadd(aPrinter,Trim(cName)+" , "+Trim(cPort))
EndDo
Next
Return(aPrinter)
//-------------------------------------
Function VerifyINI( _section_, _entry_, _var_, _inifile_, _grava_ )
//-------------------------------------
oIni := TIni():New( _inifile_ )
if _grava_ = .t.
oIni:Set( _section_, _entry_, _var_ )
endif
return oIni:Get( _section_, _entry_, _var_, _var_ )
//-------------------------------------
Function IsWin95()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if oSystemInfo:nPlatform<2 .AND. oSystemInfo:nMajor=4 .AND. oSystemInfo:nMinor=0 .AND. oSystemInfo:nBuild=950
return .t.
endif
return .f.
//-------------------------------------
Function IsWin95SP1()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if oSystemInfo:nPlatform<2 .AND. oSystemInfo:nMajor=4 .AND. oSystemInfo:nMinor=0 .AND. oSystemInfo:nBuild<=1080
return .t.
endif
return .f.
//-------------------------------------
Function IsWin95OSR2()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if oSystemInfo:nPlatform<2 .AND. oSystemInfo:nMajor=4 .AND. oSystemInfo:nMinor<10 .AND. oSystemInfo:nBuild>1080
return .t.
endif
return .f.
//-------------------------------------
Function IsWin98()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if oSystemInfo:nPlatform<2 .AND. oSystemInfo:nMajor=4 .AND. oSystemInfo:nMinor=10 .AND. oSystemInfo:nBuild=1998
return .t.
endif
return .f.
//-------------------------------------
Function IsWin98SP1()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if oSystemInfo:nPlatform<2 .AND. oSystemInfo:nMajor=4 .AND. oSystemInfo:nMinor=10 .AND. oSystemInfo:nBuild>1998 .AND. oSystemInfo:nBuild<2183
return .t.
endif
return .f.
//-------------------------------------
Function IsWin98SE()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if oSystemInfo:nPlatform<2 .AND. oSystemInfo:nMajor=4 .AND. oSystemInfo:nMinor=10 .AND. oSystemInfo:nBuild>2183
return .t.
endif
return .f.
//-------------------------------------
Function IsWinME()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if oSystemInfo:nPlatform<2 .AND. oSystemInfo:nMajor=4 .AND. oSystemInfo:nMinor=90 .AND. oSystemInfo:nBuild>2183
return .t.
endif
return .f.
//-------------------------------------
Function IsWinNT31()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if oSystemInfo:nPlatform=2 .AND. oSystemInfo:nMajor=3 .AND. oSystemInfo:nMinor=10
return .t.
endif
return .f.
//-------------------------------------
Function IsWinNT35()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if oSystemInfo:nPlatform=2 .AND. oSystemInfo:nMajor=3 .AND. oSystemInfo:nMinor=50
return .t.
endif
return .f.
//-------------------------------------
Function IsWinNT351()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if oSystemInfo:nPlatform=2 .AND. oSystemInfo:nMajor=3 .AND. oSystemInfo:nMinor=51
return .t.
endif
return .f.
//-------------------------------------
Function IsWinNT4()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if oSystemInfo:nPlatform=2 .AND. oSystemInfo:nMajor=4
return .t.
endif
return .f.
//-------------------------------------
Function IsWin2000()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if lWin2000
return .t.
endif
return .f.
//-------------------------------------
Function IsWinXP()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if oSystemInfo:nPlatform=2 .AND. oSystemInfo:nMajor=5 .AND. oSystemInfo:nMinor=1
return .t.
endif
return .f.
//-------------------------------------
Function IsWin2003()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if oSystemInfo:nPlatform=2 .AND. oSystemInfo:nMajor=5 .AND. oSystemInfo:nMinor=2
return .t.
endif
return .f.
//-------------------------------------
Function ServicePack()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if If(lWin2000,"Service pack "+Ltrim(Str(oSystemInfo:wSerPackM)),"")
return .t.
endif
return .f.
//-------------------------------------
Function IsNTPreWin2K()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if oSystemInfo:nPlatform=2 .AND. oSystemInfo:nMajor<=4
return .t.
endif
return .f.
//-------------------------------------
Function IsNTWorkstation()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if oSystemInfo:IsNTPreWin2K() .AND. Upper(oSystemInfo:WhichNT())="WINNT"
return .t.
endif
return .f.
//-------------------------------------
Function IsNTServer()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if oSystemInfo:IsNTPreWin2K() .AND. Upper(oSystemInfo:WhichNT())="SERVERNT"
return .t.
endif
return .f.
//-------------------------------------
Function IsWin2000Prof()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if lWin2000 .AND. Upper(oSystemInfo:WhichNT())="WINNT"
return .t.
endif
return .f.
//-------------------------------------
Function IsWin2000Server()
//-------------------------------------
local oSystemInfo:=TSystemInfo():New()
if lWin2000 .AND. ( Upper(oSystemInfo:WhichNT())="SERVERNT" .OR. Upper(oSystemInfo:WhichNT())="LANMANNT")
return .t.
endif
return .f.
#include "tsystem.prg"
Code: Select all
#include "FiveWin.ch"
//------------------------------------------------------------------------
#include "struct.ch"
#include "DLL.CH"
#define HKEY_CURRENT_USER 2147483649 // 0x80000001
#define HKEY_LOCAL_MACHINE 2147483650 // 0x80000002
#DEFINE MEM_TotalPhys 1
#DEFINE MEM_AvailPhys 2
#DEFINE MEM_TotalPageFile 3
#DEFINE MEM_AvailPageFile 4
#DEFINE MEM_TotalVirtual 5
#DEFINE MEM_AvailVirtual 6
CLASS TSystemInfo
DATA nOsVer, nMajor, nMinor, nBuild, nPlatform, cSP
DATA wSerPackM, wSerPacki, wSteMask, wProdType, wRes
DATA TSIVersion
METHOD New( lTest )
METHOD WinVer()
METHOD VerNum() INLINE LTrim( Str( ::nMajor ) ) + "." +;
LTrim( Str( ::nMinor ) ) + "." +;
LTrim( Str( ::nBuild ) ) +;
RTrim( " " + ::cSP ) // added by LKM
METHOD WhichNT()
METHOD TimeZone()
METHOD DateSystemBios()
METHOD NameSystemBios()
METHOD DateVideoBios()
METHOD NameVideoBios()
METHOD ComputerName()
METHOD IEStartPage()
METHOD IEVersion()
METHOD DTWallpaper()
METHOD DirectxVersion()
METHOD Ass4Ext(cExt) // Associated programme for this extention
METHOD BootDir()
METHOD GetColors()
METHOD SpeedCPU(nCPU)
METHOD CPU() INLINE GetCPU()
METHOD IsDualCPU() INLINE ::SpeedCPU(2)>0
METHOD CPUVendor(nCPU)
METHOD CPUIdentifier(nCPU)
METHOD IsWin95() INLINE ::nPlatform<2 .AND. ::nMajor=4 .AND. ::nMinor=0 .AND. ::nBuild=950
METHOD IsWin95SP1() INLINE ::nPlatform<2 .AND. ::nMajor=4 .AND. ::nMinor=0 .AND. ::nBuild<=1080
METHOD IsWin95OSR2() INLINE ::nPlatform<2 .AND. ::nMajor=4 .AND. ::nMinor<10 .AND. ::nBuild>1080
METHOD IsWin98() INLINE ::nPlatform<2 .AND. ::nMajor=4 .AND. ::nMinor=10 .AND. ::nBuild=1998
METHOD IsWin98SP1() INLINE ::nPlatform<2 .AND. ::nMajor=4 .AND. ::nMinor=10 .AND. ::nBuild>1998 .AND. ::nBuild<2183
METHOD IsWin98SE() INLINE ::nPlatform<2 .AND. ::nMajor=4 .AND. ::nMinor=10 .AND. ::nBuild>2183
METHOD IsWinME() INLINE ::nPlatform<2 .AND. ::nMajor=4 .AND. ::nMinor=90 .AND. ::nBuild>2183
METHOD IsWinNT31() INLINE ::nPlatform=2 .AND. ::nMajor=3 .AND. ::nMinor=10
METHOD IsWinNT35() INLINE ::nPlatform=2 .AND. ::nMajor=3 .AND. ::nMinor=50
METHOD IsWinNT351() INLINE ::nPlatform=2 .AND. ::nMajor=3 .AND. ::nMinor=51
METHOD IsWinNT4() INLINE ::nPlatform=2 .AND. ::nMajor=4
METHOD IsWin2000() INLINE lWin2000
METHOD IsWinVistaUltimate() INLINE ::nPlatform=2 .AND. ::nMajor=6 .AND. ::nMinor=0 .AND. ::nBuild=6000
METHOD IsWinXP() INLINE ::nPlatform=2 .AND. ::nMajor=5 .AND. ::nMinor=1
METHOD IsWin2003() INLINE ::nPlatform=2 .AND. ::nMajor=5 .AND. ::nMinor=2
METHOD ServicePack() INLINE If(lWin2000,"Service pack "+Ltrim(Str(::wSerPackM)),"")
METHOD IsNTPreWin2K() INLINE ::nPlatform=2 .AND. ::nMajor<=4
METHOD IsNTWorkstation() INLINE ::IsNTPreWin2K() .AND. Upper(::WhichNT())="WINNT"
METHOD IsNTServer() INLINE ::IsNTPreWin2K() .AND. Upper(::WhichNT())="SERVERNT"
METHOD IsWin2000Prof() INLINE lWin2000 .AND. Upper(::WhichNT())="WINNT"
METHOD IsWin2000Server() INLINE lWin2000 .AND. ( Upper(::WhichNT())="SERVERNT" .OR. Upper(::WhichNT())="LANMANNT")
//METHOD IsWin2003Prof() INLINE lWin2000 .AND. Upper(::WhichNT())="WINNT"
//METHOD IsWin2003Server() INLINE lWin2000 .AND. ( Upper(::WhichNT())="SERVERNT" .OR. Upper(::WhichNT())="LANMANNT")
METHOD Memory(n)
ENDCLASS
//-----------------------------------
METHOD New( lTest ) CLASS TSystemInfo
LOCAL buffer, sInfo
::TSIVersion:="1.04"
if Valtype( lTest )#"L"
lTest:=.f.
endif
lWin2000:=IsWin2K()
STRUCT sInfo
MEMBER nLOsVer AS DWORD // Size of the structure
MEMBER nLMajor AS DWORD // Major windows Version
MEMBER nLMinor AS DWORD // Minor Windows Version
MEMBER nLBuild AS DWORD // Build Number
MEMBER nLPlatform AS DWORD // Wich Platform
MEMBER cLSP AS STRING LEN 128 // Service Pack (Nt/2000)
if lWin2000
MEMBER wLSerPackM AS WORD
MEMBER wLSerPacki AS WORD
MEMBER wLSteMask AS WORD
MEMBER wLProdType AS BYTE
MEMBER wLRes AS BYTE
endif
ENDSTRUCT
sInfo:Setmember(1,sInfo:Sizeof())
buffer:=sInfo:cBuffer
if GetVerExA(@buffer) <> 1
MsgInfo("Error on Calling GetVersionExA")
return self
endif
sInfo:cBuffer:=buffer
::nOSVer :=nLoWord(sInfo:nLOSVer)
::nMajor :=nLoWord(sInfo:nLMajor)
::nMinor :=nLoWord(sInfo:nLMinor)
::nBuild :=nLoWord(sInfo:nLBuild)
::nPlatform:=nLoWord(sInfo:nLPlatform)
::cSP :=Alltrim(psz(sInfo:cLSP))
if lWin2000
::wSerPackM:=nLoWord(sInfo:wLSerPackM)
::wSerPacki:=nLoWord(sInfo:wLSerPacki)
::wSteMask :=nLoWord(sInfo:wLSteMask)
::wProdType:=sInfo:wLProdType
::wRes :=sInfo:wLRes
endif
if lTest
MsgInfo("nOsVers = " +LTrim(Str(::nOsVer)) +CRLF+;
"nMajor = " +LTrim(Str(::nMajor)) +CRLF+;
"nMinor = " +LTrim(Str(::nMinor)) +CRLF+;
"nBuild = " +LTrim(Str(::nBuild)) +CRLF+;
"sPlatform = " +LTrim(Str(::nPlatform)) +CRLF+;
"cSP = " + AllTrim(::cSP))
if lWin2000
MsgInfo("wSerPackM = " +LTrim(Str(::wSerPackM))+CRLF+;
"wSerPacki = " +LTrim(Str(::wSerPacki))+CRLF+;
"wSteMask = " +LTrim(Str(::wSteMask ))+CRLF+;
"wProdType = " +LTrim(Str(::wProdType))+CRLF+;
"wRes = " +LTrim(Str(::wRes ))+CRLF,"Windows2000 Info")
endif
endif
return Self
//--------------------------------------------------------------------
Function IsWin2K()
LOCAL sInfo, buffer
STRUCT sInfo
MEMBER OsVer AS DWORD // Size of the structure
MEMBER Major AS DWORD // Major windows Version
MEMBER Minor AS DWORD // Minor Windows Version
MEMBER Build AS DWORD // Build Number
MEMBER Platform AS DWORD // Wich Platform
MEMBER SP AS STRING LEN 128 // Service Pack (Nt/2000)
ENDSTRUCT
sInfo:Setmember(1,sInfo:Sizeof())
buffer:=sInfo:cBuffer
if GetVerExA(@buffer) <> 1
MsgInfo("Error on Calling GetVersionExA")
return .f.
endif
sInfo:cBuffer:=buffer
RETURN (sInfo:Platform=2 .AND. sInfo:Major=5 .AND. sInfo:Minor=0)
//--------------------------------------------------------------------
METHOD WinVer( ) CLASS TSystemInfo
LOCAL cVersion:=""
DO CASE
CASE ::IsWin95() ; cVersion:="Windows 95"
CASE ::IsWin95SP1() ; cVersion:="Windows 95 Service pack 1"
CASE ::IsWin95OSR2() ; cVersion:="Windows 95 OSR2"
CASE ::IsWin98() ; cVersion:="Windows 98"
CASE ::IsWin98SP1() ; cVersion:="Windows 98 Service pack 1"
CASE ::IsWin98SE() ; cVersion:="Windows 98 Second Edition"
CASE ::IsWinME() ; cVersion:="Windows ME"
CASE ::IsWinNT31() ; cVersion:="Windows NT 3.1"
CASE ::IsWinNT35() ; cVersion:="Windows NT 3.5"
CASE ::IsWinNT351() ; cVersion:="Windows NT 3.51"
CASE ::IsWinNT4() ; cVersion:="Windows NT 4"
CASE ::IsWin2000() ; cVersion:="Windows 2000 "+If(::IsWin2000Prof,"Professional","Server")+" "+AllTrim(::cSP)+" build "+LTrim(Str(::nBuild))
CASE ::IsWinXP() ; cVersion:="Windows XP build "+LTrim(Str(::nBuild))+" "+::cSP
CASE ::IsWin2003() ; cVersion:="Windows 2003 "+If(::IsWin2000Prof,"Professional","Server")+" "+AllTrim(::cSP)+" build "+LTrim(Str(::nBuild))
CASE ::IsWinVistaUltimate(); cVersion:="Windows Vista Ultimate"
//CASE ::IsWin2003Prof() ; cVersion:="Windows 2003 Professional "+AllTrim(::cSP)+" build "+LTrim(Str(::nBuild))
//CASE ::IsWin2003Server() ; cVersion:="Windows 2003 Server "+AllTrim(::cSP)+" build "+LTrim(Str(::nBuild))
OTHER ; cVersion:="Unknown Windows version"
ENDCASE
RETURN cVersion
//--------------------------------------------------------------------
METHOD WhichNT() CLASS TSystemInfo
LOCAL oReg, uVar
oReg := TReg32():New(HKEY_LOCAL_MACHINE,"System\CurrentControlSet\Control\ProductOptions",.f.)
uVar := oReg:Get("ProductType","")
oReg:Close()
RETURN uVar
//--------------------------------------------------------------------
METHOD DateSystemBios() CLASS TSystemInfo
LOCAL oReg, uVar
oReg := TReg32():New(HKEY_LOCAL_MACHINE,"HARDWARE\DESCRIPTION\System",.f.)
uVar := oReg:Get("SystemBiosdate","")
oReg:Close()
if Empty(uVar)
oReg := TReg32():New(HKEY_LOCAL_MACHINE,"Enum\Root\*PNP0C01\0000",.f.)
uVar := oReg:Get("Biosdate","")
oReg:Close()
endif
RETURN uVar
//--------------------------------------------------------------------
METHOD NameSystemBios() CLASS TSystemInfo
LOCAL oReg, uVar
oReg := TReg32():New(HKEY_LOCAL_MACHINE,"HARDWARE\DESCRIPTION\System",.f.)
uVar := RTrim( Remove0( oReg:Get("SystemBiosVersion","") ) )
oReg:Close()
if Empty(uVar)
oReg := TReg32():New(HKEY_LOCAL_MACHINE,"Enum\Root\*PNP0C01\0000",.f.)
uVar := Remove0( oReg:Get("BiosName","")+" "+oReg:Get("BiosVersion","") )
oReg:Close()
endif
RETURN uVar
//--------------------------------------------------------------------
METHOD DateVideoBios() CLASS TSystemInfo
LOCAL oReg, uVar
oReg := TReg32():New(HKEY_LOCAL_MACHINE,"HARDWARE\DESCRIPTION\System",.f.)
uVar := oReg:Get("VideoBiosdate","")
oReg:Close()
RETURN uVar
//--------------------------------------------------------------------
METHOD NameVideoBios() CLASS TSystemInfo
LOCAL oReg, uVar
oReg := TReg32():New(HKEY_LOCAL_MACHINE,"HARDWARE\DESCRIPTION\System",.f.)
uVar := RTrim( Remove0( oReg:Get("VideoBiosVersion","") ) )
oReg:Close()
RETURN uVar
//--------------------------------------------------------------------
METHOD Computername() CLASS TSystemInfo
LOCAL oReg, uVar
oReg := TReg32():New(HKEY_LOCAL_MACHINE,"SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName",.f.)
uVar := oReg:Get("Computername","")
oReg:Close()
RETURN uVar
//--------------------------------------------------------------------
METHOD TimeZOne() CLASS TSystemInfo
LOCAL oReg, uVar
oReg := TReg32():New(HKEY_LOCAL_MACHINE,"SYSTEM\CurrentControlSet\Control\TimeZoneInformation",.f.)
uVar := oReg:Get("StandardName","")
oReg:Close()
RETURN uVar
//--------------------------------------------------------------------
METHOD IEStartPage() CLASS TSystemInfo
LOCAL oReg, uVar
oReg := TReg32():New(HKEY_CURRENT_USER,"Software\Microsoft\Internet Explorer\Main",.f.)
uVar := oReg:Get("Start Page","")
oReg:Close()
RETURN uVar
//--------------------------------------------------------------------
METHOD IEVersion() CLASS TSystemInfo
LOCAL oReg, uVar
oReg := TReg32():New(HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\Internet Explorer",.f.)
uVar := oReg:Get("Version","")
oReg:Close()
RETURN uVar
//--------------------------------------------------------------------
METHOD DTWallpaper() CLASS TSystemInfo //DesktopWallpaper
LOCAL oReg, uVar
oReg := TReg32():New(HKEY_CURRENT_USER,"Software\Microsoft\Internet Explorer\Desktop\General",.f.)
uVar := oReg:Get("Wallpaper","")
oReg:Close()
RETURN uVar
//--------------------------------------------------------------------
METHOD SpeedCPU(nCPU) CLASS TSystemInfo
LOCAL oReg, uVar
if ValType(nCPU)#"N"
nCPU:=1
endif
if ::nPlatform<2 //Win95-98-ME
uVar:=0
else
oReg := TReg32():New(HKEY_LOCAL_MACHINE,"HARDWARE\DESCRIPTION\System\CentralProcessor\"+LTrim(Str(nCPU-1)),.f.)
uVar := oReg:Get("~Mhz",0)
oReg:Close()
uVar:=Round(uVar/10,0)*10
endif
RETURN uVar
//--------------------------------------------------------------------
METHOD CPUVendor(nCPU) CLASS TSystemInfo
LOCAL oReg, uVar
if ValType(nCPU)#"N"
nCPU:=1
endif
oReg := TReg32():New(HKEY_LOCAL_MACHINE,"HARDWARE\DESCRIPTION\System\CentralProcessor\"+LTrim(Str(nCPU-1)),.f.)
uVar := oReg:Get("VendorIdentifier","")
oReg:Close()
RETURN uVar
//--------------------------------------------------------------------
METHOD CPUIdentifier(nCPU) CLASS TSystemInfo
LOCAL oReg, uVar
if ValType(nCPU)#"N"
nCPU:=1
endif
oReg := TReg32():New(HKEY_LOCAL_MACHINE,"HARDWARE\DESCRIPTION\System\CentralProcessor\"+LTrim(Str(nCPU-1)),.f.)
uVar := oReg:Get("Identifier","")
oReg:Close()
RETURN uVar
//--------------------------------------------------------------------
METHOD DirectXVersion() CLASS TSystemInfo
LOCAL oReg, uVar
oReg := TReg32():New(HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\DirectX",.f.)
uVar := oReg:Get("Version","")
oReg:Close()
RETURN uVar
//--------------------------------------------------------------------
METHOD Ass4Ext(cExt) CLASS TSystemInfo
LOCAL oReg, uVar
if ValType(cExt)#"C"
RETURN ""
endif
if Left(cExt,1)#"."
cExt:="."+cExt
endif
oReg := TReg32():New(HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\Windows\CurrentVersion\Extensions",.f.)
uVar := oReg:Get(cExt,"")
oReg:Close()
RETURN SubStr(uVar,1,Len(uVar)-(Len(cExt)+2))
//--------------------------------------------------------------------
METHOD BootDir() CLASS TSystemInfo
LOCAL oReg, uVar
oReg := TReg32():New(HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\Windows\CurrentVersion\Setup",.f.)
uVar := oReg:Get("BootDir","")
oReg:Close()
RETURN uVar
//--------------------------------------------------------------------
METHOD Memory(n) CLASS TSystemInfo
/* ------ DESABILITEI QUANDO ATUALIZEI O HARBOUR 2007 */
LOCAL nRetu
#ifdef __HARBOUR__
#pragma BEGINDUMP
#include "windows.h"
#pragma ENDDUMP
nRetu := HB_INLINE( n )
{
MEMORYSTATUS mst;
long n = hb_parnl(1);
mst.dwLength = sizeof( MEMORYSTATUS );
GlobalMemoryStatus( &mst );
switch( n )
{
case 1: hb_retnl( mst.dwTotalPhys / (1024*1024) ) ; break;
case 2: hb_retnl( mst.dwAvailPhys / (1024*1024) ) ; break;
case 3: hb_retnl( mst.dwTotalPageFile / (1024*1024) ) ; break;
case 4: hb_retnl( mst.dwAvailPageFile / (1024*1024) ) ; break;
case 5: hb_retnl( mst.dwTotalVirtual / (1024*1024) ) ; break;
case 6: hb_retnl( mst.dwAvailVirtual / (1024*1024) ) ; break;
default: hb_retnl( 0 ) ;
}
}
#else
LOCAL oMemory
STRUCT oMemory
MEMBER m1 AS LONG // nSize
MEMBER m2 AS LONG // Memory Load
MEMBER m3 AS LONG // Total Physical
MEMBER m4 AS LONG // Available Physical
MEMBER m5 AS LONG // Total Page File
MEMBER m6 AS LONG // Available Page File
MEMBER m7 AS LONG // Total Virtual
MEMBER m8 AS LONG // Available Virtual
ENDSTRUCT
oMemory:m1 = oMemory:SizeOf()
MemStat( oMemory:cBuffer )
DO CASE
CASE n=1 ; nRetu:=Round( oMemory:m3 / (1024*1024) ,0 )
CASE n=2 ; nRetu:=Round( oMemory:m4 / (1024*1024) ,0 )
CASE n=3 ; nRetu:=Round( oMemory:m5 / (1024*1024) ,0 )
CASE n=4 ; nRetu:=Round( oMemory:m6 / (1024*1024) ,0 )
CASE n=5 ; nRetu:=Round( oMemory:m7 / (1024*1024) ,0 )
CASE n=6 ; nRetu:=Round( oMemory:m8 / (1024*1024) ,0 )
OTHERWISE; nRetu:=0
ENDCASE
#endif
RETURN nRetu
//--------------------------------------------------------------------
#ifndef __HARBOUR__
DLL32 STATIC FUNCTION MemStat( pMEMORY AS LPSTR ) AS VOID;
PASCAL FROM "GlobalMemoryStatus" LIB "KERNEL32.DLL"
#endif
//--------------------------------------------------------------------
METHOD GetColors() CLASS TSystemInfo
LOCAL hDC, nPlanes, nBitsPixel
hDC := CreateDC("DISPLAY", "", "")
nPlanes := GetDeviceCaps(hDC, 14)
nBitsPixel:= GetDeviceCaps(hDC, 12)
DeleteDC(hDc)
RETURN Int(2^(nPlanes*nBitsPixel))
//--------------------------------------------------------------------
DLL32 FUNCTION GetVerExA( @lpVersionInformation AS LPSTR );
AS LONG PASCAL FROM "GetVersionExA" LIB "KERNEL32.DLL"
STATIC Function psz( c ) ; RETURN substr( c, 1, At( Chr(0), c ) - 1 )
STATIC Function Remove0( c ) ; RETURN StrTran( c, Chr(0), " " )
//#ifdef __HARBOUR__
// #pragma BEGINDUMP
// static void hb_retnl( LONG l )
// {
// hb_itemPutNL( &hb_stack.Return, l );
// }
// #pragma ENDDUMP
//#endif