Tenho um problema que me atormenta à alguns meses em VB6 e não lhe consigo dar a volta, já uma vez me deram algumas ajudas por cá mas acabei por adiar a criação do programa a 100% e agora um amigo meu precisa dele a sério e tenho que o acabar, vamos ver se consigo explicar o que pretendo, e julgo que é informação que pode ser muito útil para mais pessoas: List e textbox tem um limite, penso que se tratam de 64kb de informação no seu interior. Há dll's que com arrays ou outro metodo que não explicam muito bem, removem o limite "virtual" de uma listbox, entre outros metodos, mas estes DLL's são muito complexos, ou pagos, sim, eu encontrei um DLL que faz o que quero, resolve o problema, e custa 30€ e ainda não consegui arranjar outra alternativa. O problema resume-se a isto, um amigo meu é dono de uma empresa de publicidade, legal claro, e tem mailing list's de todo o tipo mas na sua maioria são list's de discotecas e dj's. Estas listas tem gente que pede para ser removido obviamente, e são adicionadas e removidas semanalmente umas centenas de pessoas, a adição e remoção de repetidos foi um processo simples, o problema em si, seria criar um programa que com 2 listbox's ou uma textbox e uma listbox, tenha a lista completa, e do outro lado quem pretende ser removido. fiz um programa que ao carregar linha a linha para a textbox verificava se o mail pretendia ser removido da listagem da direita, que como é pequena corre sem problemas, mas depressa me apercebi que embora o programa funcione, quando o processo termina e a lista tem por exemplo 200.000 e-mails e largos minutos depois, vejo que a textbox não tem um centésimo do conteudo lá dentro visto só suportar os tais 64kb. Percebi então que o problema se depara com a memória, criação de threads entre outras coisas, o que eu não sei fazer. Estudei um pouco a situação e também descobri que posso usar dois ficheiros, em disco, que podem ser comparados em memória e gravados a cada X percentagem do total do processo ou mesmo só no seu fim, e que pode nem sequer haver necessidade de mostrar visualmente a lista total, apenas a lista de remoção que pode ser um ficheiro de texto carregado para uma listbox e este processo pode ser feito com a utilização do ciclo FOR ou com o REPLACE que funciona lindamente. Por exemplo: Código: Text1.Text = Replace(Text1.Text, List1.List(contadordalista), "") Agora, alguem me sabe ajudar com isto, a nivel de threads ou tem uma ideia de como contornar este problema? Não é a primeira vez que necessito de fazer algo deste genero, e me deparo com os limites virtuais do programa. Nota: o código seja como for, deverá facilitar a rápida verificação dos e-mails, pois uma lista com 250.000 e-mails com 50 remoção, significa que cada linha dos 250.000 mails será verificada 50 vezes. A menos que alguem tenha uma ideia que eu não tive, isto implica ou ter um bom pc, ou ter muiiita paciência. Fico grato por qualquer ajuda que me possam dar neste sentido e também agradecia se alguem me quizer adicionar ao msn para facilitar o processo, mesmo assim caso encontrada uma solução irei coloca-la aqui.
Já me deparei com um problema parecido mas era em termos de rapidez, escrever 14.000 mil linhas vindas de uma base dados..uma forma de tornares isso mais rápdio é gravares em TXT com o FileSystemObject e leres apartir de lá! Com o TXT consegues ler linha a linha por isso é so arranjares a lógica e aplicares
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
Quanto a segurança podes estar descansado pk isto é legal, o meu amigo paga mais de 7000€ por ano em licenças para o poder fazer legalmente. não é spam; Gostava que me ajudasses era com uma coisa, eu sei o codigo de comparação e tudo, não sei é como APAGAR o e-mail do ficheiro de texto sem ter que o abrir para uma textbox ou para uma listbox porque ambas tem limite, a única coisa que não tem limites é mesmo a memoria do pc, carregando uma lista de 100.000 mails para uma textbox, ela é totalmente carregada mas não fica a informação toda na textbox, o meu colega diz k nem passa dos mails começados por "A", há perdas de informação enormes, então criei variáveis de contagem para fazerem o acompanhamento e vi que teoricamente ele carrega tudo através de uma variável mas no fim não está la tudo. como posso então: - Carregar x vezes o TXT para cada X mails a serem removidos - Quando o e-mail for encontrado, como eliminar essa linha no TXT sem deixar espaços em branco?
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
Não é por nada, mas falas muito de segurança e dizes para guardar os emails num ficheiro de texto absolutamente normal? Nesse caso o mais fiável seria codificar as strings de entrada com algum algoritmo de encriptação..., mas sinceramente acho que a melhor opção é sempre o uso de uma base de dados. abraços, HecKel
sim ajuda, so falta um pormenor é que nao é para remover um mail mas sim muitos e nao se pode percorrer uma textbox, só uma listbox, vou pegar nisto para ver se faço um ciclozito mas parece-me que ajuda. depois digo aqui o que concluí
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
bem estou agradecido a todos, consegui atravez da funcao que o angelofwisdom fez apenas alterar umas coisas no clique do command 1 e pronto, cá está: Código: Dim contador As Long removidos = 0 mantidos = 0 For contador = 1 To List1.ListCount If RemoverMailDaLista(List1.List(contador)) Then removidos = removidos + 1 total = total + 1 Else mantidos = mantidos + 1 total = total + 1 End If Label4.Caption = mantidos Label2.Caption = removidos Label6.Caption = total DoEvents ProgressBar1.Value = ProgressBar1.Value + 1 Next contador DoEvents se tiverem alguma ideia de optimização do código, sou todo ouvidos as variáveis não declaradas estão no general do form
À 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
sim mas tirando isso, a nivel de optimização do codigo ou mesmo da parte da função axo que é tudo, parece que temos este problema resolvido. Estou muito agradecido a toda a malta que cá anda e queima neurónios para poder ajudar quem precisa
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
Ah eu so meti umas labels com a caption do calculo isto foi feito um pouco à pressa para o meu amigo k precisa deste software como um homem de ar para respirar. Ele recebe diáriamente mails a pedir para entrar nas listas, mas obviamente ha gente que pede remoção, imagina tirar um a um 50 ou 100 mails de uma lista de 500.000 com copy-paste e ctrl+f e delete, etc etc. Foi feito embora um pouco à pressa, o que importa no fim é mesmo só o valor dos removidos e que o programa funcione, o que já me deu provas de fazer
Em VB.net o limite é igual ? Eu em menus só conseguia 128(?) items, e em .net até agora não cheguei ao limite! Pode ser que alguns objectos tenham sido melhorados.