Problema de limitações em VB

FSO não é com VBScripting? com isso não sei mexer...

Podes é criar um ficheiro .TXT, e a cada pedido de remoção de e-mail, abres o ficheiro, lê-lo linha a linha até encontrares o mail em questão, e removes o mail quando for encontrado. Caso não seja encontrado, podes sempre dizer "o e-mail não consta da nossa base de dados"

Aconselho-te a teres muito cuidado com esses ficheiros, e com a forma com que envias os mails, de modo a não haverem "fugas" de informação

Abraços [[[[[[[[[[]]]]]]]]]]]
angelofwisdom

 

Percebeste-me mal o que eu estava a dizer era para teres cuidado com esse ficheiro específico.
Imagina que o servidor é crackado e conseguem fazer download dele? Corres o risco da base de dados se espalhar.

Bem, pus-me aqui a brincar, e já cá tens o que precisas:

1) abre um novo projecto
2) GRAVA-O numa pasta específica
3) cria um ficheiro com o nome "database.txt" na mesma pasta
4) escreve para o conteúdo do database.txt o seguinte:

Código:

[noparse]
[email protected]
[email protected]
[email protected]
[email protected]
[email protected]
[email protected]
[email protected]
[/noparse]

5) no form, cola o seguinte código:

Código:

Option Explicit
Private Function RemoverMailDaLista(email As String) As Boolean
    On Error GoTo ErrorHandler
 
    Dim buffer      As String
    Dim ficheiro    As String
    Dim tmp         As String
 
    ficheiro = App.Path & "\database.txt"
    tmp = ficheiro & ".tmp"
 
    Open ficheiro For Input As #1
        Open tmp For Output As #2
            Do Until EOF(1)
                Line Input #1, buffer
                If Not Trim(UCase(buffer)) = Trim(UCase(email)) Then
                    Print #2, buffer
                Else
                    RemoverMailDaLista = True
                End If
            Loop
        Close #2
    Close #1
    Kill ficheiro
    Name tmp As ficheiro
 
    Exit Function
 
ErrorHandler:
    MsgBox "Ocorreu um erro ao remover o e-mail da lista: [" & Error(Err) & "] (erro #" & CStr(Err) & ").", vbCritical
End Function
Private Sub Command1_Click()
    If RemoverMailDaLista(Text1.Text) Then
        MsgBox "Mail removido com sucesso", vbInformation
    Else
        MsgBox "O Mail não consta da lista, ou ocorreu um erro.", vbExclamation
    End If
End Sub

6) Coloca no form uma textbox (onde irás escrever o mail a remover) e um botão (onde, ao clicares, irás chamar a função). Deixa os nomes standard - Text1 e Command1

7) executa o programa e vê o resultado. Escreve mails inválidos, escreve mail que estejam no ficheiro... remove um mail e tenta removê-lo de novo... "protege" o ficheiro com permissões Read-Only... pensa em tudo o que puder acontecer tanto ao ficheiro como ao programa... vê bugs.... epah, beta-testa-o xD

Aqui já te dei bastante coisas ... agora é contigo o que fazes com ele
edit - não te esqueças dum pormenor... ler do ficheiro A, gravar no ficheiro B, apagar o A e renomear o B pode revelar-se perigoso (por exemplo, se não for possível modificar o B e ele apagar o A). Tens aí muita coisa a mudar apenas te dei um "empurrão"-zão xD

Espero ter ajudado em alguma coisa

Abraços [[[[[[[]]]]]]]]
angelofwisdom

 

HecKel, eu tinha pensado em referir a encriptação, e era para falar disso mais tarde... só que como ainda estava a explicar os primeiros passos em file i/o, acho que falar de encriptação neste momento seria muito precipitado.

Mas posso sempre meter aqui uma codificação muito mais básica \m/ CÉSAR FTW \m/ e não me custa nada.

Na base de dados, mete o seguinte:

Código:

pqrstuOx~{=ƒ
@ABCDEFOx~{=ƒ
‚t…xs~Op{v„t‚=r~|
t‚‚~p‚Ov|px{=r~|
x‚ƒ~t„|p~rpxpO‰|px{=r~|
prw~€„typrwtvpO~ƒ|px{=~v
€„p{€„tr~x‚pOw~ƒ|px{=r~|

e o código será este:

Código:

Option Explicit
Private Function RemoverMailDaLista(email As String) As Boolean
    On Error GoTo ErrorHandler
 
    Dim buffer      As String
    Dim ficheiro    As String
    Dim tmp         As String
 
    ficheiro = App.Path & "\database.txt"
    tmp = App.Path & "\database.tmp"
 
    Open ficheiro For Input As #1
        Open tmp For Output As #2
            Do Until EOF(1)
                Line Input #1, buffer
                buffer = decode(buffer, 15)
                If Not Trim(UCase(buffer)) = Trim(UCase(email)) Then
                    Print #2, encode(buffer, 15)
                Else
                    RemoverMailDaLista = True
                End If
            Loop
        Close #2
    Close #1
    Kill ficheiro
    Name tmp As ficheiro
 
    Exit Function
 
ErrorHandler:
    MsgBox "Ocorreu um erro ao remover o e-mail da lista: [" & Error(Err) & "] (erro #" & CStr(Err) & ").", vbCritical
End Function
Private Sub Command1_Click()
    If RemoverMailDaLista(Text1.Text) Then
        MsgBox "Mail removido com sucesso", vbInformation
    Else
        MsgBox "O Mail não consta da lista, ou ocorreu um erro.", vbExclamation
    End If
End Sub
Private Function encode(What As String, HowManyChars As Integer)
    Dim i       As Integer
    Dim CurByte As Integer
    Dim finalstr As String
 
    FixManyChars HowManyChars
 
    For i = 1 To Len(What)
        CurByte = Asc(Mid(What, i, 1))
        CurByte = CurByte + HowManyChars
        If CurByte > 255 Then CurByte = CurByte - 255
        finalstr = finalstr & Chr(CurByte)
    Next i
 
    encode = finalstr
End Function
Private Function decode(What As String, HowManyChars As Integer)
    Dim i       As Integer
    Dim CurByte As Integer
    Dim finalstr As String
 
    FixManyChars HowManyChars
 
    For i = 1 To Len(What)
        CurByte = Asc(Mid(What, i, 1))
        CurByte = CurByte - HowManyChars
        If CurByte < 0 Then CurByte = CurByte + 255
        finalstr = finalstr & Chr(CurByte)
    Next i
 
    decode = finalstr
End Function
'Private Sub Form_Load()
'   'activa isto quando quiseres encriptar o ficheiro da base de dados inteiro
'
'   Dim buffer As String
'    Open App.Path & "\database.txt" For Input As #1
'        Open App.Path & "\coded_db.txt" For Output As #2
'            Do Until EOF(1)
'                Line Input #1, buffer
'                buffer = encode(buffer, 15)
'                Print #2, buffer
'            Loop
'        Close #2
'    Close #1
'    Unload Me
'End Sub
Private Sub FixManyChars(ByRef Number As Integer)
    If Number < 1 Then Exit Sub
 
    If Number > 255 Then
        Do Until Number < 255
            Number = Number - 255
        Loop
    End If
End Sub

Tem muito mais coisas.
Tens a função FixManyChars (que só serve para auxiliar as outras duas). Não a uses que não é necessária

Encode ( String_a_codificar, número de caracteres )
Decode ( String_a_descodificar, número de caracteres IGUAL ao anterior)

Ele descodifica cada linha do ficheiro, compara-a ao e-mail a remover, e se não for esse, recodifica-a e grava-a de novo.

O Form_Load, fi-lo para encriptar a "base de dados" de modo a que os emails que já existiam em plain text ficam codificados noutro ficheiro.


Isto acaba por se tornar confuso a determinado ponto, àqueles que ainda têm pouca experiência no VB. Daí eu não ter querido mencionar mais cedo.


O meu código, apesar de eu ter-lhe dado uns retoques, pode ser bastante optimizado. Mas neste momento já não tenho tempo para isso soz...

Espero ter ajudado

Cumps [[[[[[[]]]]]]]]
angelofwisdom

 

À primeira vista, digo-te uma coisa que é lógica: se puderes usar menos variáveis, a memória agradece (se bem que com os 512MB ou 1GB que existem hoje em dia, uma variável já não faz grande diferença)...
O total é a soma dos que apagou com o que não apagou (não há meio termo ). Logo, teres um total = total + 1 é desnecessário.
Label6.Caption = mantidos + removidos

 

Anytime

Hmmm não sei se isso estará correcto... agora que dei uma vista de olhos mais pormenorizada...

Código:

    If RemoverMailDaLista(List1.List(contador)) Then
        removidos = removidos + 1
        total = total + 1
    Else
        mantidos = mantidos + 1
        total = total + 1
    End If

A função RemoverMailDaLista só retorna dois valores: True e False.
Se retornar True, o e-mail foi removido da lista com sucesso.
Se retornar False, das duas uma: ou não constava da lista, ou houve um erro.

Estás a considerar o True como removido e o False como mantido ... mas qual é o objectivo de tentares remover um e-mail e considerá-lo como "mantido" caso este não exista ou não possa ser apagado?

Acho que nesse caso, em vez de Removidos e Mantidos, seria Removidos_com_sucesso e Nao_Removidos.

Não estou a perceber muito bem o que pretendes com esse código. A menos que tenhas feito alterações no meu de modo a fazer o que queres mas não o tenhas mostrado (e daí eu não estar a perceber a coisa :x )

Abraços [[[[[[[]]]]]]]
angelofwisdom