Não gosto de postar assim, mas no momento estou sem tempo, espero que entenda, esta rotina uso para enviar dados para painel eletronico, via modem, no caso esta usando um modem externo, mas interno tambem funciona, desde que esteja instalado no windows, e devidamente configurado.
** Módulo : EnviaModem.prg **
** Comentário : Transmitir dados para painel, via modem **
** Data : 05/10/2006 - Oliveira, Sérgio A. **
**-----------------------------------------------------------**
#Include "FiveWin.ch"
#include "Phone.ch"
**-----------------------------------------------------------**
Function EnviaModem()
#define FULL_SIZE 405
#define HALF_SIZE 260
#define IN_BUFFER 40
#define TERM_SIZE 300
extern Set, GetTextWidth
static oSpeaker, oHangDown, oLocalNum, oNumber
Private nComm, cTerminal, oTerminal, cNumber,xPacote:="", xPcte:=.f.
**-----------------------------------------------------------**
Private noESC[1],oDlg[1],oBotao[5],cStatusModen:=''
AFILL(noESC,.f.)
**-----------------------------------------------------------**
_Top:=oWnd:nTop()+200
_Lef:=oWnd:nLeft()+170
_Bot:=_Top+260
_Rig:=_Lef+468
cTitulo :=" ..:: Enviar dados para painel ::. " //+AllTrim(ModemName())+" ::.."
cLocalNum:="35235299"
cNumber := pAlinha("0w1435235299",20,"E")
**-----------------------------------------------------------**
IF(! File("ARQUIVOS\ConfigPainel.DBC"))
MsgInfo("Dados para transmissão ainda não configurados. "+CRLF+"Efetue no módulo configurar."," .:: Atenção ::.")
RETURN(.f.)
ENDIF
IF(! File("ARQUIVOS\LinhaPainel.DBC"))
MsgInfo("Nenhum dado para enviar ao painel"," .:: Atenção ::.")
RETURN(.f.)
ENDIF
Use "arquivos\LinhaPainel.DBC" Index "arquivos\LinhaPainel.IND" Exclusive Alias "PNL" New
Use "arquivos\ConfigPainel.DBC" Exclusive Alias "CFG" New
PNL->(DBGoTop())
IF (PNL->(Eof() ))
MsgInfo("Nenhum dado para enviar ao painel.",".:: Atenção ::.")
DBCloseAll()
RETURN(.t.)
EndIf
cPorta:=AllTrim(CFG->PortaCom) //ModemPort())
cNumber:=""
//cNumber:=cNumber+IIf(CFG->PrefxLin==" ","",CFG->PrefxLin+"W")
cNumber:=cNumber+IIf(CFG->FixarOpe=="S",CFG->CodigOpe+"-"+CFG->CodigDdd+"-"+CFG->NumerFon,CFG->numerFon)
DEFINE DIALOG oDlg[1] From _Top,_Lef to _Bot,_Rig OF oWnd Pixel FONT fNormal COLOR PRETO,CINZACC TITLE cTitulo Style(DS_MODALFRAME)
oDlg[1]:bCommNotify:={|nComm, nStatus|BytesAtPort(nComm,nStatus)}
@ 008,010 Say "Telefone no Painel" OF oDlg[1] Pixel Size 055,007 FONT fNormal COLOR PRETO,CINZACC
@ 015,010 GET oNumber VAR cNumber Picture "@!K" OF oDlg[1] Pixel Size 055,009 FONT fGet COLOR VERMELHO,FundoGet UPDATE ReadOnly
// @ 030,010 BUTTON oBotao[1] Prompt "Discar" OF oDlg[1] Pixel Size 055,015 FONT fNormal ACTION If( ! Empty( cNumber ), ( HangUp( .f. ), LigarNumero( cNumber ) ),)
@ 030,010 BUTTON oBotao[2] Prompt "Enviar Dados" OF oDlg[1] Pixel Size 055,015 FONT fNormal ACTION MandaDados(xPcte:=.t.)
// @ 070,010 BUTTON oBotao[3] Prompt "Fechar Conexão" OF oDlg[1] Pixel Size 055,015 FONT fNormal ACTION Hangdown()
@ 050,010 BUTTON oBotao[4] PROMPT "Sair" OF oDlg[1] Pixel Size 055,015 FONT fBold ACTION (noESC[1]:=.t.,oDlg[1]:End())
@ 008,070 Say "Status da Comunicação" OF oDlg[1] Pixel Size 100,007 FONT fNormal COLOR PRETO,CINZACC
@ 015,070 GET oTerminal VAR cTerminal OF oDlg[1] Pixel Size 155,090 FONT fGet COLOR AZUL,FundoGet UPDATE MULTILINE
ACTIVATE DIALOG oDlg[1] ON INIT (If( ! InitModem(), oDlg[1]:End(),(HangUp(.f.),LigarNumero(cNumber)) ),;
EnableCommNotification( nComm, oDlg[1]:hWnd, IN_BUFFER, IN_BUFFER ) );
VALID ( CloseComm( nComm ), noESC[1] )
dbCloseall()
Return(NIL)
**-------------------------------**
Static Function InitModem()
**-------------------------------**
Local cDcb, nError, nBytes
nComm = OpenComm( cPorta, 1024, 128 )
If(! BuildCommDcb( cPorta+":1200,n,8,1", @cDcb ))
nError = GetCommError( nComm )
cTerminal:="Erro inicializando modem !!!" ; oTerminal:Refresh()
oBotao[2]:Disable()
Return(.F.)
ENDIF
If( nBytes := WriteComm( nComm, "ATZ0" + Chr( 13 ) ) ) < 0
nError = GetCommError( nComm )
cTerminal:="Erro inicializando modem !!!" ; oTerminal:Refresh()
oBotao[1]:Disable()
oBotao[2]:Disable()
oBotao[3]:Disable()
Return(.F.)
Endif
Return(.t.)
**-------------------------------------------------**
Static function BytesAtPort( nComm, nStatus )
**-------------------------------------------------**
Local cBuffer := Space( IN_BUFFER )
DEFAULT cTerminal := Space( TERM_SIZE )
ReadComm( nComm, @cBuffer )
cBuffer:=StrTran(cBuffer,"ATZ0","Modem inicializado com sucesso.")
cBuffer:=StrTran(cBuffer,"OK","")
cBuffer:=StrTran(cBuffer,"TH","")
cBuffer:=Strtran(cBuffer,"ATDP","Discando para : ")
cBuffer:=Strtran(cBuffer,"ATDT","Discando para : ")
cBuffer:=StrTran(cBuffer,"ATH","Fechando conexão")
cBuffer:=StrTran(cBuffer,"BUSY","Telefone ocupado")
cBuffer:=StrTran(cBuffer,"CONNECT","Conectado ")
cBuffer:=StrTran(cBuffer,"NO DIALTONE","Sem sinal para discar.")
cBuffer:=StrTran(cBuffer,"NO CARRIER","Telefone não atende.")
If (! Empty(xPacote))
cBuffer:=""
If (xPcte)
cBuffer:="Enviando dados para painel"
xPcte:=.f.
EndIf
EndIf
If (!Empty(cBuffer))
cTerminal = PadR( AllTrim( cTerminal ) + AllTrim( cBuffer ) +CRLF,TERM_SIZE )
ENDIF
oTerminal:Refresh()
Return(NIL)
**------------------------------------------**
Static Function LigarNumero( cNumber )
**------------------------------------------**
LOCAL cNumero:=IIf(CFG->PrefxLin==" ","",CFG->PrefxLin+"W")+StrTran(cNumber,"-",""), nBytes:=WriteComm( nComm, AllTrim( cNumero ) + Chr( 13 ) )
If(nBytes < 0)
MsgStop( "Modem error: " + Str( GetCommError( nComm ) ) )
ENDIF
Return(NIL)
**--------------------------------**
Static Function HangUp(lOpen)
**--------------------------------**
nBytes := WriteComm( nComm, "ATD"+AllTrim(CFG->TipoFone)+ If( lOpen, Chr( 13 ), " " ) )
if nBytes < 0
MsgStop( "Modem error: " + Str( GetCommError( nComm ) ) )
Endif
Return(NIL)
**------------------------------**
Static Function HangDown()
**------------------------------**
Local cTexto:=""
nBytes := WriteComm( nComm, "ATH" )
if nBytes < 0
MsgStop( "Modem error: " + Str( GetCommError( nComm ) ) )
Endif
SysWait(0.05)
**--[ Fecha porta Serial ]--**
CloseComm( nComm )
SysWait(0.05)
cTexto:="Conexão Encerrada"
cTerminal:=PadR( AllTrim( cTerminal ) + cTexto + CRLF,TERM_SIZE )
oTerminal:Refresh()
Return(NIL)
**-------------------------------**
Static Function MandaDados()
**-------------------------------**
PNL->(DBGoTop())
xPacote:="[L1]"
WHILE(PNL->(!Eof() ))
xLin1:=AnsiToOem(PNL->bailin)
xLin2:=AnsiToOem(PNL->menlin)
xPacote+="[M1"+pAlinha(xLin1,12,"C")+"]"
xPacote+="[M2"+pAlinha(xlin2,12,"C")+"]"
xPacote+="[P"+StrZero(PNL->temlin,1)+"]"
PNL->(DBSkip(1))
ENDDO
xPacote+="[F]"
nBytes := WriteComm( nComm, xPacote + Chr( 13 ) )
if nBytes < 0
MsgStop( "Modem error: " + Str( GetCommError( nComm ) ) )
endif
SysWait(2)
cTexto:="Dados enviados com sucesso"
cTerminal:=PadR( AllTrim( cTerminal ) + cTexto + CRLF,TERM_SIZE )
oTerminal:Refresh()
Return(NIL)
**------------------------------------------------**
** Configuracoes de modem instalado no windows **
**------------------------------------------------**
FUNCTION ModemName()
Local oReg, uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\Class\{4D36E96D-E325-11CE-BFC1-08002BE10318}\0000", .f. )
uVar := RTrim(oReg:Get( "DriverDesc", "" ))
oReg:Close()
If Empty( uVar )
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\Class\Modem\0000", .f. )
uVar := RTrim(oReg:Get( "DriverDesc", "" ))
oReg:Close()
Endif
Return uVar
FUNCTION ModemVersion()
Local oReg, uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\Class\{4D36E96D-E325-11CE-BFC1-08002BE10318}\0000", .f. )
uVar := RTrim(oReg:Get( "DriverVersion", "" ))
oReg:Close()
If Empty( uVar )
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\Class\Modem\0000", .f. )
uVar := RTrim( oReg:Get( "DriverVersion", "" ) )
oReg:Close()
Endif
Return uVar
FUNCTION ModemPort()
Local oReg, uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\Class\{4D36E96D-E325-11CE-BFC1-08002BE10318}\0000", .f. )
uVar := RTrim( oReg:Get( "AttachedTo", "" ) )
oReg:Close()
If Empty( uVar ) // Win95-98-ME doesn't have the above key
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\Class\Modem\0000", .f. )
uVar := RTrim( oReg:Get( "AttachedTo", "" ) )
oReg:Close()
Endif
Return uVar
id=code>id=code>-------------------------------------------------------------------
Boleto with Personal/FastReport it is very, very good, beyond prettier.
FWH 904a, xH 1.2.1, SqlLib, MySql, ActiveX
