Envio de Faxes en FWH

[Mike Serra]

Buenos días foro!

Teneis por ahi algún ejemplo de envio de una imagen por fax? He estado probando código que hay en el foro pero no he conseguido dar con la tecla.

Muchas Gracias de antemano.

[Rochinha]

Mira en se te ayuda:

http://www.fivetechsoft.com/forums/view ... ght=winfax

http://www.fivetechsoft.com/forums/view ... ght=winfax

[Mike Serra]

Gracias Rochinha por contestar,

con respecto al primer link NO lo he probado porque no tengo el WINFAX, y con respecto al segundo, instalé el servicio de Fax para windows xp, y compile el código, pero siempre me sale un mensaje de alerta poniendo nil, que pienso que es porque no se conecta bien con el servicio.

mi codigo

Code: Select all  Expand view

Function WinFaxDDE(oWnd,FaxFile,FaxNumber,SendTime,SendDate,FaxName,Company,;
                   Subject,Keyword,BillingCode,Modo)
    local oWinFaxDDE
   DEFAULT FaxFile    := "c:\prueba.txt" ,;
           FaxNumber  := "0,957764272"    ,;
           SendTime   := ""             ,;
           SendDate   := ""             ,;
           FaxName    := "CDI" ,;
           Company    := "CDI"    ,;
           Subject    := "Test de FAX" ,;
           keyword    := ""             ,;
           BillingCode:= ""             ,;
           Modo       := "Fax"

   if oWinFaxDDE == nil
      oWinFaxDDE:=TDDE():New(OWND,"FAXMNG32","CONTROL")
      oWinFaxDDE:Activate()
      ?MsgInfo( "Ativando o WinFAX" )
   else
      ?MsgInfo( "WinFAX ja esta ativado" )
   endif
   oWinFaxDDE:Execute( "GoIdle" )
   oWinFaxDDE:end()

   oWinFaxDDE1:=TDDE():New(OWND,"FAXMNG32","TRANSMIT")
   oWinFaxDDE1:Activate()

   rec := "recipient("+chr(34)+;
          FaxNumber+chr(34)+","+chr(34)+;
          SendTime+chr(34)+","+chr(34)+;
          SendDate+chr(34)+","+chr(34)+;
          FaxName+chr(34)+","+chr(34)+;
          Company+chr(34)+","+chr(34)+;
          Subject+chr(34)+","+chr(34)+;
          keyword+chr(34)+","+chr(34)+;
          BillingCode+chr(34)+","+chr(34)+;
          modo+chr(34)+")"

   //oWinFaxDDE1:Poke(1,"sendfax",rec)
   //oWinFaxDDE1:Poke(1,"sendfax","attach("+chr(34)+faxfile+chr(34)+")",5)
   //oWinFaxDDE1:Poke(1,"sendfax","SendfaxUI")
   oWinFaxDDE1:Execute( rec )
   oWinFaxDDE1:Execute( 'attach('+chr(34)+faxfile+chr(34)+')' )
   oWinFaxDDE1:Execute( "GoIdle" )
   oWinFaxDDE1:Execute( "SendFaxUI" )
   oWinFaxDDE1:end()

   oWinFaxDDE2:=TDDE():New(OWND,"FAXMNG32","CONTROL")
   oWinFaxDDE2:Activate()
   oWinFaxDDE2:Execute( "GoActive" )
   msginfo("Fax Enviado")
return nil


[Rochinha]

Amigo,

Activa lo servicos de Fax de tu XP or Windows 2000/2003 en SERVICES.

[Biel EA6DD]

Al hilo de este tema, tengo una aplicacion para la que tengo que incorporar el envio de fax. En su dia hice pruebas con WinFax, y funciona perfectamente, el tema es que este producto creo se ha descontinuado, o bien a cambiado de fabricante/nombre.

Con winfax, la verdad es que es bastante facil de implementar, pero no me apetece basarme sobre un producto descontinuado. Seguier con atención los avances que puedas hacer Mike, y si alguine sabe de winfax o similiar, agradeceria lo comentara.

[Mike Serra]

Vamos avanzando Rochinha,

Era correcto, no estaba activado el servicio, solo instalado. Ya no me salen errores, ahora el problema es que no hace nada. Te pongo como he dejado el PRG:

Code: Select all  Expand view

#include "fivewin.ch"

static ownd,oWinFaxDDE,oWinFaxDDE1,oWinFaxDDE2,oWinFaxDDE3

Function Main()
    define window OWND from 0,0 to 10,10
    activate window OWND on init EnviaFax()
return

static function EnviaFax(FaxFile,FaxNumber,SendTime,SendDate,FaxName,Company,Subject,Keyword,BillingCode,Modo)
    local rec
    DEFAULT FaxFile    := "c:\prueba.txt" ,;
           FaxNumber   := "0 957764272"    ,;
           SendTime    := ""             ,;
           SendDate    := ""             ,;
           FaxName     := "CDI" ,;
           Company     := "CDI"    ,;
           Subject     := "Test de FAX" ,;
           keyword     := ""             ,;
           BillingCode := ""             ,;
           Modo        := "Fax"

    if oWinFaxDDE == nil
        oWinFaxDDE:=TDDE():New(OWND,"FAXMNG32","CONTROL")
        oWinFaxDDE:Activate()
        ?MsgInfo( "Ativando o WinFAX" )
    else
        ?MsgInfo( "WinFAX ja esta ativado" )
    endif
    oWinFaxDDE:Execute( "GoIdle" )
    oWinFaxDDE:end()

    oWinFaxDDE1:=TDDE():New(OWND,"FAXMNG32","TRANSMIT")
    oWinFaxDDE1:Activate()

    rec := "recipient("+chr(34)+;
          FaxNumber+chr(34)+","+chr(34)+;
          SendTime+chr(34)+","+chr(34)+;
          SendDate+chr(34)+","+chr(34)+;
          FaxName+chr(34)+","+chr(34)+;
          Company+chr(34)+","+chr(34)+;
          Subject+chr(34)+","+chr(34)+;
          keyword+chr(34)+","+chr(34)+;
          BillingCode+chr(34)+","+chr(34)+;
          modo+chr(34)+")"
    msginfo(rec)
    //oWinFaxDDE1:Poke(1,"sendfax",rec)
    //oWinFaxDDE1:Poke(1,"sendfax","attach("+chr(34)+faxfile+chr(34)+")",5)
    //oWinFaxDDE1:Poke(1,"sendfax","SendfaxUI")
    oWinFaxDDE1:Execute( rec )
    oWinFaxDDE1:Execute( 'attach('+chr(34)+faxfile+chr(34)+')' )
    oWinFaxDDE1:Execute( "GoIdle" )
    oWinFaxDDE1:Execute( "SendFaxUI" )
    oWinFaxDDE1:end()
    oWinFaxDDE2:=TDDE():New(OWND,"FAXMNG32","CONTROL")
    oWinFaxDDE2:Activate()
    oWinFaxDDE2:Execute( "GoActive" )
    msginfo("Fax Enviado")
return nil


Otro problema que tenía es que nuestro fax para obtener linea exterior y enviar el fax, necesitaba esta cadena:

Code: Select all  Expand view


          FaxNumber   := "0,957764272" ,;


Y lo he dejado asi:

Code: Select all  Expand view

           FaxNumber   := "0 957764272"    ,;


Alguna solución?

Muchísimas gracias.

[hmpaquito]

biel, encontre esto:


_________________________________
_________________________________
Re: Faxing with xHarbour

"Gene Stempel" <genestempel@mindspring.com> ha scritto nel messaggio
news:ft70eu$hp7$1@aioe.org...

This is a working sample for Windows XP:

FUNCTION MAIN()

LOCAL oFax := CREATEOBJECT( "FaxComEx.FaxServer" )

LOCAL oDoc := CREATEOBJECT( "FaxComEx.FaxDocument" )

oFax:Connect( "" )

oDoc:Body = "E:\XHARBOUR\TEST.DOC"

oDococumentName = "Fax test"

oDoc:Recipients:Add( "0639728261" )

oDoc:ConnectedSubmit( oFax )

oFaxisconnect()

RETURN NIL

EMG

--
EMAG Software Homepage: http://www.emagsoftware.it
The EMG's ZX-Spectrum Page: http://www.emagsoftware.it/spectrum
The Best of Spectrum Games: http://www.emagsoftware.it/tbosg
The EMG Music page: http://www.emagsoftware.it/emgmusic
_________________________________
_________________________________


saludos

[Rochinha]

Mike,

Mira mi applicacion en http://www.5volution.com/app02.asp

La misma usa:

HBFax.prg

Code: Select all  Expand view

#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"


HBFax.rc

Code: Select all  Expand view

hbfax ICON "hbfax.ico"
hbfaxon ICON
{
'00 00 01 00 01 00 10 10 10 00 00 00 00 00 28 01'
'00 00 16 00 00 00 28 00 00 00 10 00 00 00 20 00'
'00 00 01 00 04 00 00 00 00 00 C0 00 00 00 00 00'
'00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00'
'00 00 00 00 80 00 00 80 00 00 00 80 80 00 80 00'
'00 00 80 00 80 00 80 80 00 00 80 80 80 00 C0 C0'
'C0 00 00 00 FF 00 00 FF 00 00 00 FF FF 00 FF 00'
'00 00 FF 00 FF 00 FF FF 00 00 FF FF FF 00 00 00'
'00 00 00 00 00 00 00 00 00 00 00 00 00 00 0B BB'
'B7 77 7B B0 00 00 0B BB B7 77 7B B0 00 00 0B BB'
'B7 77 B1 10 8B 00 08 88 88 88 81 10 0B 00 00 BB'
'BB BB BB 0B BB 00 00 00 BB BB 00 00 0B 00 00 00'
'00 00 BB BB BB 00 00 00 00 B0 00 00 0B 00 00 00'
'00 BB BB BB BB 00 00 00 00 B0 00 00 0B 00 00 00'
'00 BB BB BB BB 00 00 00 00 B0 00 BB BB 00 00 00'
'00 BB BB BB BB 00 00 00 00 00 00 00 00 00 FF FF'
'00 00 00 0F 00 00 00 0F 00 00 00 01 00 00 00 01'
'00 00 00 01 00 00 80 01 00 00 C0 01 00 00 F0 01'
'00 00 F8 01 00 00 F8 01 00 00 F8 01 00 00 F8 01'
'00 00 F8 01 00 00 F8 01 00 00 F8 01 00 00'
}
hbfaxoff ICON
{
'00 00 01 00 01 00 10 10 10 00 00 00 00 00 28 01'
'00 00 16 00 00 00 28 00 00 00 10 00 00 00 20 00'
'00 00 01 00 04 00 00 00 00 00 C0 00 00 00 00 00'
'00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00'
'00 00 00 00 80 00 00 80 00 00 00 80 80 00 80 00'
'00 00 80 00 80 00 80 80 00 00 80 80 80 00 C0 C0'
'C0 00 00 00 FF 00 00 FF 00 00 00 FF FF 00 FF 00'
'00 00 FF 00 FF 00 FF FF 00 00 FF FF FF 00 07 77'
'77 77 77 77 70 00 00 00 00 00 00 00 70 00 0F FF'
'F7 77 7F F0 77 77 0F FF F7 77 7F F0 00 07 0F FF'
'F7 77 F1 10 8F 07 08 88 88 88 81 10 0F 07 00 FF'
'FF FF FF 0F FF 07 00 00 FF FF 00 00 0F 07 00 00'
'00 00 FF FF FF 07 00 00 00 F0 00 00 0F 07 00 00'
'00 FF FF FF FF 07 00 00 00 F0 00 00 0F 07 00 00'
'00 FF FF FF FF 07 00 00 00 F0 00 FF FF 07 00 00'
'00 FF FF FF FF 07 00 00 00 00 00 00 00 00 80 07'
'00 00 00 07 00 00 00 00 00 00 00 00 00 00 00 00'
'00 00 00 00 00 00 80 00 00 00 C0 00 00 00 F0 00'
'00 00 F8 00 00 00 F8 00 00 00 F8 00 00 00 F8 00'
'00 00 F8 00 00 00 F8 00 00 00 F8 01 00 00'
}


TSystem.prg

Code: Select all  Expand view

#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


[Mike Serra]

Buenas Tardes hmpaquito.
Ante todo muchas gracias a todos por vuestra colaboración y deciros que el código de hmpaquito funciona perfectamente, simplemente instalando el servicio de fax de windows xp y activandolo, el código, va perfecto. Ahora bien, seguiré experimentando a partir de este hilo, porque lo que me faltaría es poder enviar una imagen, ya que si en el código sustituyo el fichero de texto por uno de una imagen, no funciona. De todas formas, por ahora me soluciona bien mi problema.

Muchas Gracias y Saludos a todos .

[triumvirato]

biel, encontre esto:


_________________________________
_________________________________
Re: Faxing with xHarbour

"Gene Stempel" <genestempel@mindspring.com> ha scritto nel messaggio
news:ft70eu$hp7$1@aioe.org...

This is a working sample for Windows XP:

FUNCTION MAIN()

LOCAL oFax := CREATEOBJECT( "FaxComEx.FaxServer" )

LOCAL oDoc := CREATEOBJECT( "FaxComEx.FaxDocument" )

oFax:Connect( "" )

oDoc:Body = "E:\XHARBOUR\TEST.DOC"

oDococumentName = "Fax test"

oDoc:Recipients:Add( "0639728261" )

oDoc:ConnectedSubmit( oFax )

oFaxisconnect()

RETURN NIL

EMG

--
EMAG Software Homepage: http://www.emagsoftware.it
The EMG's ZX-Spectrum Page: http://www.emagsoftware.it/spectrum
The Best of Spectrum Games: http://www.emagsoftware.it/tbosg
The EMG Music page: http://www.emagsoftware.it/emgmusic
_________________________________
_________________________________


saludos

A mí ese código, con el servicio de fax activado, etc. me dá el siguiente error:

Application
===========
Path and name: C:\Fivewin\gesco\pruefax.exe (32 bits)
Size: 1,398,784 bytes
Time from start: 0 hours 0 mins 0 secs
Error occurred at: 11/20/08, 09:58:22
Error description: Error FaxComEx.FaxDocument/3 DISP_E_MEMBERNOTFOUND: CONNECTEDSUBMIT
Args:
[ 1] = O Object

Stack Calls
===========
Called from: source\rtl\win32ole.prg => TOLEAUTO:CONNECTEDSUBMIT(0)
Called from: C:\Fivewin\gesco\pruefax.prg => MAIN(19)

En la línea:

Code: Select all  Expand view

oDoc:ConnectedSubmit( oFax )

Alguna sugerencia? Trabajo desde XP.
GRACIAS y saludos!

[Biel EA6DD]

biel, encontre esto:


Re: Faxing with xHarbour
...
saludos

Muchas gracias hmpaquito, pues va perfecto. Especialmente me alegra el hecho de no tener que depender de software de otro fabricante, puesto que viene incluido en el SO, ademas se maneja como OLE, mucho mejor que DDE, y encima hay bastante documentcion en internet.

Apuntate un 10. Gracias.

[triumvirato]

Muchas gracias hmpaquito, pues va perfecto.

Biel,

Desde XP o vista?

La verdad que si hay documentación, pero yo el inconveniente de que sea OLE lo veo en los dichosos eventos que no se pueden controlar...

Saludos!

[hmpaquito]

triunvirato,

quiza te de error por tu version de xharbour-harbour. prueba con xharbour 1.0.0 o +

saludos

[Biel EA6DD]

[quote="triumviratoBiel,

Desde XP o vista?

La verdad que si hay documentación, pero yo el inconveniente de que sea OLE lo veo en los dichosos eventos que no se pueden controlar...

Saludos![/quote]
Windows XP profesional Version 2002 Service Pack 3

Lo de los eventos, tienes toda la razon, nos vendria muy bien el poderlos controlar.

[triumvirato]

triunvirato,

quiza te de error por tu version de xharbour-harbour. prueba con xharbour 1.0.0 o +

saludos

hmpaquito,

he probado con varias versiones de xharbour hasta la 1.1.0 rev.6195 sin resultados, no parece ser ese el problema, se agradecen sugerencias.

Biel,

Gracias, también uso XP pero tengo problemas...

Saludos!