'Nome       : VBS_Com.exp
'Tipo       : VBS
'Data       : 2011/08/03
'Versao     : 1.0
'Descricao  : VB Script - Exemplo de funcoes

'==============================================================================
'#VER - Historia de modificacoes
'==============================================================================
'- Versao : 1.0   ____/__/__ --------------------------------------------------
'Versao base


'==============================================================================
#PGM - Programa/Funcoes
'==============================================================================
'- +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
'- (13) --->'Comentario
'- (25) --------------->'Comentario
'- (28) ------------------>'Comentario
'- (40) ------------------------------>'Comentario
'- (43) --------------------------------->'Comentario
'- (46) ------------------------------------>'Comentario
'- (49) --------------------------------------->'Comentario
'- (52) ------------------------------------------>'Comentario
'- (55) --------------------------------------------->'Comentario
'- (58) ------------------------------------------------>'Comentario
'- (61) --------------------------------------------------->'Comentario

Sub Usar_VBS 'usar funcoes de VB Script
res = VBS_Funcao(arg)                    'valor de funcao em VB Script
end sub

##


'==============================================================================
#VBS - VB Script
'==============================================================================
'- +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
'- (13) --->'Comentario
'- (25) --------------->'Comentario
'- (28) ------------------>'Comentario
'- (40) ------------------------------>'Comentario
'- (43) --------------------------------->'Comentario
'- (46) ------------------------------------>'Comentario
'- (49) --------------------------------------->'Comentario
'- (52) ------------------------------------------>'Comentario
'- (55) --------------------------------------------->'Comentario
'- (58) ------------------------------------------------>'Comentario
'- (61) --------------------------------------------------->'Comentario


'- variaveis globais ----------------------------------------------------------
dim var                                'variavel
dim obAce                              'acesso a objecto


'------------------------------------------------------------------------------
'= SUP - Funcoes de suporte ===================================================
'------------------------------------------------------------------------------
'Sub DbgMsg 'mensagem de DEBUG
'msgbox "Mensagem de DEBUG"
'msgbox "Ini: "+cStr(tip)
'end sub


'------------------------------------------------------------------------------
'- OBJ - Acesso a objectos ----------------------------------------------------
'------------------------------------------------------------------------------
Function ObjAcePrp(arg) 'preparar acesso
'arg        - argumento (nao usado)

Set obDoc = CreateObject("DLL.API")                'preparar acesso

'terminar
ObjAcePrp = 1                                      'devolver resultado
end function


Function ObjAceLib(arg) 'libertar acesso
'arg        - argumento (nao usado)

Set obDoc = Nothing                                'destruir acesso a listagem

'terminar
ObjAceLib = 1                                      'devolver resultado
end function


'------------------------------------------------------------------------------
'- Funcoes de suporte - SIG ---------------------------------------------------
'------------------------------------------------------------------------------
Sub SigAjtDtl(dtb, dtl) 'ajustar data
'dtb        - data base
'dtl        - data de lancamento

'ORG=200103010000                      'AAAAMMDDHHSS
'DES=200103010300000                   'AAAAMMDDCC00000

'tmp = cStr(dtb)                        'conversao de data em texto
'Call NumCnvTxt(dtb, -15, "0", tmp)       'converter em texto/ajustar
'msgbox "AjtDtl 1 >" & dtb + "< >" + tmp + "<"

txAno = mid(tmp, 7, 2)                 'texto para ano
txMes = mid(tmp, 4, 2)                 'texto para mes
txDia = mid(tmp, 1, 2)                 'texto para dia

dtl=txAno+txMes+txDia+txMes+"00000"    'gerar data

'msgbox "AjtDtl >" + tmp + "< >" + dtl + "<"
end sub


'------------------------------------------------------------------------------
'- NUM - Numero ---------------------------------------------------------------
'------------------------------------------------------------------------------
Sub NumCnv(vtx, num) 'conversao em numero
'vtx        - valor/texto
'num        - valor numero

on error resume next                   'controlar erros

'msgbox "NumCnv >"+vtx+"<"

num=0                                  'assume valor zero
if vtx = "" then
   num = 0                             'valor zero
else
   num = cDbl(vtx)                     'conversao em numero
end if

on error goto 0                        'terminar controlo de erros
end sub


Sub NumTxt(num, dig, ce, tx) 'converter numero em texto
'num        - numero a converter (pode estar em texto)
'dig        - numero de digitos
'ce         - caractere de enchimento (para numero >=0)
'tx         - texto

'NOTA: Se o numero for negativo forca o enchimento a espacos

on error resume next                   'controlar erros

tmp=0                                           'assume valor zero

tmp=cDbl(num)                                   'copiar
tx = LTrim(cStr(tmp))                           'converter para texto
If tmp < 0 Then                                 'negativo ?
   tx = Right(String(dig, " ") + tx, dig)       'ajustar tamanho
Else                                            'zero ou positivo
   tx = Right(String(dig, ce) + tx, dig)        'ajustar tamanho
End If

on error goto 0                        'terminar controlo de erros
end sub


Sub NumCnvTxt(num, dig, ce, tx) 'converter numero em texto
'num        - numero a converter (pode estar em texto)
'dig        - numero de digitos  (>0 enche a esq. , <0 enche a dir.)
'ce         - caractere de enchimento (para numero >=0)
'tx         - texto

on error resume next                   'controlar erros

call TxtCnv(num, ntx)                  'conversao em texto
ndi = abs(dig)                         'numero de digitos

If dig > 0 Then                        'enchimento a esquerda ?
   tmp = String(ndi, ce) + ntx         'enchimento a esquerda
   tx = Right(tmp, ndi)                'ajustar tamanho
Else
   tmp = ntx + String(ndi, ce)         'enchimento a direita
   tx = left(tmp, ndi)                 'ajustar tamanho
End If

on error goto 0                        'terminar controlo de erros
end sub


'------------------------------------------------------------------------------
'- TXT - Texto ----------------------------------------------------------------
'------------------------------------------------------------------------------
Sub TxtCnv(vl, vtx) 'conversao em texto
'vl         - valor a converter
'vtx        - valor em texto

on error resume next                   'controlar erros

'msgbox "NumCnv >"+vtx+"<"

vtx = ""                               'assume nulo
vtx = Trim(cStr(vl))                   'converter para texto

on error goto 0                        'terminar controlo de erros
end sub


Sub TxtSep(tx, sp, txs) 'separar texto
'tx         - texto original/residual
'sp         - separador
'txs        - texto separado

'msgbox "TxtSep >" + tx + "<"

p = InStr(tx, sp)                      'pesquisa do separador
If p <> 0 Then                         'encontrou separador
   txs = Left(tx, p - 1)               'texto separado
   tx  = Mid(tx, p + 1)                'texto residual
Else                                   'nao encontrou separador
   txs = tx                            'texto separado (tudo)
   tx  = ""                            'texto residual (nada)
End If
end sub


Sub TxtSepAsp(mo, vtx, sep, txs) 'separar texto com controlo de aspas
'mo         - modo
'vtx        - texto original/residual
'sep        - separadores
'txs        - texto separado

carAspa = Chr(34)                      'caractere aspa
ndi = Len(vtx)                         'tamanho do texto
aspaSim = 0                            'dentro de aspas (invalido)
AspaNao = 1                            'fora de aspas   (valido)

pSep = 0                               'invalidar separador
For i = 1 To ndi
car = Mid(vtx, i, 1)                   'caractere a analisar

If car = carAspa Then                  'aspa ?
   Swap aspaSim, AspaNao               'mudar situacao
   carOk = 0                           'invalidar caractere
Else
   carOk = 1                           'validar caractere
End If

If aspaSim = 1 Or carOk = 0 Then       'entre aspas/invalido ?
   'nada a executar
Else
   psqSep = InStr(sep, car)            'verificar se e um separador
   If psqSep <> 0 Then                 'e separador ?
      pSep = i                         'actualizar posicao
      Exit For                         'terminar
   End If
End If
Next

'terminar
If pSep = 0 Then                       'sem separdores ?
   txs = vtx                           'texto separado - tudo
   vtx = ""                            'texto residual - nada
Else
   txs = Left(vtx, pSep - 1)           'texto separado
   vtx = Mid(vtx, pSep + 1)            'texto residual
End If

If mo = "T" Then                       'executar trim ?
   vtx = Trim(vtx)                     'ajustar
   txs = Trim(txs)                     'ajustar
End If
end sub


Sub TxtSepEa(tx, sp, txs) 'separar texto e ajustar (eliminar aspas)
'tx         - texto original/residual
'sp         - separador
'txs        - texto separado

call TxtSepAsp("T", tx, sp, tmp)       'separar texto
txs = TxtEliAspa(tmp)                  'eliminar aspas nos extremos
end sub


Sub TxtSepNum(tx, sp, num) 'separar texto para numero
'tx         - texto original/residual
'sp         - separador
'num        - numero separado

call TxtSep(tx, sp, txs)               'separar texto
call NumCnv(txs, num)                  'conversao em numero
end sub


Function TxtEliAspa(tx) 'eliminar aspas nos extremos
'tx         - texto base

'msgbox "EliAspa >" & tx & "<"

'aspa no inicio
If Left(tx, 1) = Chr(34) Then          'tem aspa ?
   tmp = Mid(tx, 2)                    'eliminar aspa
Else
   tmp = tx                            'nao tem, usa tudo
End If

'aspa no fim
If Right(tmp, 1) = Chr(34) Then        'tem aspa ?
   dig = Len(tmp) - 1                  'tamanho a usar
   tmp = Left(tmp, dig)                'eliminar aspa
End If

'terminar
TxtEliAspa = tmp                       'retornar valor
end function


Sub TxtSbt(tx, ps, txs) 'substituir texto
'tx         - texto original/apos substituicao
'ps         - posicao de seubstituicao
'txs        - texto a substituir

'msgbox "TxtSbt >" + tx + "<"

ndb = Len(tx)                          'tamanho do texto
ndi = Len(txs)                         'tamanho de substituicao
If ps < 1 Then Exit Sub                'posicao invalida, sai
If ps > ndb Then Exit Sub              'posicao invalida, sai
If ndi < 1 Then Exit Sub               'nada a substituir, sai

txa = Left(tx, ps - 1)                 'texto anterior
txr = Mid(tx, ps + ndi)                'texto residual
tmp = txa + txs + txr                  'executar substituicao
tx = Left(tmp, ndb)                    'limitar tamanho
end sub


Function TxtAjc(tx) 'ajustar texto para comparar
'tx         - texto base

res = trim(ucase(tx))                  'ajustar

'terminar
TxtAjc = res                           'retornar valor
end function


'------------------------------------------------------------------------------
'- MSG - Mensagens ------------------------------------------------------------
'------------------------------------------------------------------------------
'nao ha


'------------------------------------------------------------------------------
'- INP - Input ----------------------------------------------------------------
'------------------------------------------------------------------------------
Function InpMsg(tit, msg, vde) 'input com mensagem
'tit        - titulo
'msg        - mensagem
'vde        - valor por defeito
   
Call TxtCnv(tit, xTit)                 'conversao em texto
Call TxtCnv(msg, xMsg)                 'conversao em texto
Call TxtCnv(vde, xVde)                 'conversao em texto

res = ""                               'forcar tipo texto
res = InputBox(xMsg, xTit, xVde)       'pedir valor

'terminar
InpMsg = res                           'devolver valor
end function


'------------------------------------------------------------------------------
'- DIV - Diversos -------------------------------------------------------------
'------------------------------------------------------------------------------
Sub Swap(varA, varB) 'troca de valores de 2 variaveis
'varA       - variavel A
'varB       - variavel B

varC = varA                            'guardar valor A
varA = varB                            'actualizar valor A
varB = varC                            'actualizar valor B
end sub

##

